ich würde gerene aus allen Dateien (100 Stück) eines Verzeichnisses das jeweilige Blatt (es gibt pro Datei nur eines) die Blätter in einer Datei zusammenfassen (blatt1, Blatt2, Blatt3......).
Wer weiß Rat ?
mit Dank
Walter
Option Explicit
Sub zusammenfassung()
Dim fSearch As FileSearch
Dim wkb As Workbook, wkbZ As Workbook
Dim strPath As String
Dim iCnt As Integer
On Error GoTo ERRORHANDLER
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
.Calculation = xlCalculationManual
End With
strPath = "C:\" 'Pfad zu den Exceldateien - anpassen
Set wkbZ = Workbooks.Add
Set fSearch = Application.FileSearch
With fSearch
.NewSearch
.LookIn = strPath
.SearchSubFolders = False '<<<<Unterordner durchsuchen True/False
.FileType = msoFileTypeExcelWorkbooks
.Execute
For iCnt = 1 To .FoundFiles.Count
Set wkb = Workbooks.Open(.FoundFiles(iCnt))
wkb.Sheets(1).Copy after:=wkbZ.Sheets(wkbZ.Sheets.Count)
wkbZ.Sheets(wkbZ.Sheets.Count).Name = "Blatt " & iCnt
wkb.Close , False
Next
End With
For iCnt = 1 To 3
wkbZ.Sheets(iCnt).Delete
Next
ERRORHANDLER:
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
End With
End Sub
P.S.: Rückmeldung nicht vergessen!