Bestehende Sheets automatisch ueberschreiben
20.02.2006 09:31:39
Paul
das folgende Macro kopiert aus einem Ordner aus mehreren Dateien das Sheet Output und fuegt es in der Datei 2005.xls ein. Problem, wenn die Dateienanzahl sich aendert und ich das Macro oefter ausfuehre, dann kommt eine Fehlermeldung. Schon kopierte Sheets sind bereits umbenannt und in der Datei 2005.xls kopiert. Nochmal kopieren und benenen geht ja nicht, denn die Sheets gibt es ja bereits. Wie kann man das Macro so erweitern, dass bestehende Sheets mit gleichem Namen einfach uebershrieben werden. Hier das Macro:
Sub CopyOutput()
Set fso = CreateObject("Scripting.FileSystemObject")
WB = ThisWorkbook.Path
'Set f = fso.GetFolder(WB)
Set f = fso.GetFolder("C:\Documents and Settings\Paul\Desktop\Reports\2005\")
For Each Datei In f.Files
If Right(Datei, 4) = ".xls" Then
Workbooks.Open (Datei)
Sheets("Output").Select
Sheets("Output").Copy Before:=Workbooks("2005.xls").Sheets(1)
Workbooks(Datei.Name).Close
End If
Sheets("Output").Name = Workbooks("2005.xls").Sheets("Output").Cells(1, 1).Value
Next
End Sub