Sheets kopieren

Question

Hallo Gemeinschaft,
ich habe mir das nachfolgende Makro zusammengebastelt um das Tabellenblatt1 aus allen im Pfad befindlichen Excel Dateien in eine Datei zu kopieren. Nun möchte ich alle Arbeitsblätter aus jeder datei auslesen, krieg es aber nicht hin. Kann mir jemand helfen?

[b]'Call EventsOff
Dim a As String
a = ThisWorkbook.Path & "\"
Range("A1").FormulaR1C1 = a
Dim DateiName As String
DateiName = Dir(Worksheets("Tabelle2").Range("A1") & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:=Worksheets("Tabelle2").Range("A1") & DateiName
Workbooks(DateiName).Worksheets(1).Copy Before:=Workbooks(ThisWorkbook.Name).Worksheets(1)
'ActiveSheet.Name = DateiName
'Sheets(Worksheets.Count)
ActiveSheet.Name = Mid(DateiName, 1, 28)
Workbooks(DateiName).Close
End If
DateiName = Dir
Loop
'Call EventsOn
End Sub
danke im Voraus wim

Answer 1

Hi,

Eine mögliche Anpassung wäre folgende:

'Call EventsOff
Dim a As String
Dim lngCount As Long
a = ThisWorkbook.Path & "\"
Range("A1").FormulaR1C1 = a
Dim DateiName As String
DateiName = Dir(Worksheets("Tabelle2").Range("A1") & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:=Worksheets("Tabelle2").Range("A1") & DateiName
For lngCount = 1 To Workbooks(DateiName).Worksheets.Count
Workbooks(DateiName).Worksheets(lngCount).Copy Before:=Workbooks(ThisWorkbook.Name).Worksheets(1)
'ActiveSheet.Name = DateiName
'Sheets(Worksheets.Count)
ActiveSheet.Name = Mid(DateiName, 1, 28) & "_Sheet(" & lngCount & ")"
Next lngCount
Workbooks(DateiName).Close
End If
DateiName = Dir
Loop
'Call EventsOn
End Sub

bye
malSchauen

Answer 2

Hallo malSchauen, mit ein paar kleinen Änderungen hab ich es hinbekommen .
Danke
wim