AW: Worksheets aus mehreren Dateien importieren
20.05.2005 11:01:12
UweD
Hallo
eben war eine ähnliche Frage. Hab das Makro mal auf deine Frage abgeändert..
Sub alle_Dateien_Verzeichnis()
Dim strPath$, strExt$, strFile$, TB
strPath = "C:\Temp\" 'Pfad des Verzeichnisses ggf. anpassen
strExt = "m*.xls" 'Dateiextension ggf. anpassen
TB = 2 ' das zu kopierende Blatt
If strPath = "" Then
Exit Sub
Else
Application.ScreenUpdating = False
strFile = Dir(strPath & strExt)
On Error Resume Next ' wenn Blatt nicht enthalten
Do While Len(strFile) > 0
Workbooks.Open Filename:=strPath & strFile
Workbooks(strFile).Sheets(TB).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
If Err.Number = 9 Then GoTo Fehler
'Umbenennen der Blattes
'kann natürlich weg
ActiveSheet.Name = ActiveSheet.Name & " " & Application.Substitute(strFile, ".xls", "")
weiter:
Workbooks(strFile).Close savechanges:=False
strFile = Dir() ' nächste Datei
Loop
Application.ScreenUpdating = True
End If
Exit Sub
Fehler:
Err.Clear
MsgBox "Gewünschtes Blatt ist in Datei '" & strFile & "' nicht enthalten!"
GoTo weiter
End Sub
Gruß Uwe