VBA Dateien(alle Tab) aus Pfad in Datei kopieren
Carmen
ich habe, mit Hilfe folgendes Makro, zum Zusammenführen von Dateien aus einem Pfad in eine neue Datei und ein Tabellenbaltt, in Benutzung.
Es funktioniert ganz wunderbar, nur möchte ich jetzt, dass alle Tabellenblätter aus den Dateien in die neue Datei eingefügt werden. Ich dachte ich ersetze ActiveSheet durch Worksheets, aber es geht leider nicht!
Hat jemand einen kleinen Tipp für mich?
Vielen Dank schon Mal vorab!!!
Sub Dateien_in_eine_Tabelle_zusammenfuehren()
Dim strPfad As String
Dim oWBEx As Workbook
Dim rngNextCell As Range
Dim FileArray()
Dim LCount As Long, MaxRow As Long
'Pfad angepasst
strPfad = "C:\Dokumente und Einstellungen\Eigene Dateien\Periode\2011\01 Januar\"
'Suche Dateien im Ordner
ListFilesInFolder FileArray, strPfad, "*.xlsx", False, LCount
'was gefunden?
If LCount > 0 Then
Application.ScreenUpdating = False
For LCount = LBound(FileArray) To UBound(FileArray)
'Öffnet die Datei
Set oWBEx = Workbooks.Open(FileArray(LCount), ReadOnly:=True)
'Kopiert von den Zeilen 2 bis zum Ende wenn ab Zeile 2 was vorhanden
'aktive Tabelle in dieser Datei
With ThisWorkbook.ActiveSheet
'nächste freie Zelle
Set rngNextCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
'erste Tabelle aus der externen Datei
With oWBEx.Worksheets(1)
'letzte belegte Zelle
MaxRow = .Cells(.Rows.Count, 1).End(xlUp).Row
'letzte belegte Zeile ist nicht Zeile 1
If MaxRow > 1 Then
'Daten kopieren
.Range("A2", .Cells(MaxRow, 1)).EntireRow.Copy rngNextCell
End If
'Datei schließen
oWBEx.Close False
End With 'oWBEx.Worksheets(1)
End With 'ThisWorkbook.ActiveSheet
Next LCount
Application.ScreenUpdating = True
End If
End Sub