======[VBA] [Excel] Importieren der ersten Sheets aller Workbooks eines Verzeichnises====== 'Referenz auf 'Microsoft Scripting Runtime' muss gesetzt sein 'Referenz auf Microsoft Excel muss gesetzt sein '/** ' Importiert Wdie Worksheets ' @param Directory-Pfad Public Function importWs(Optional sourceFolderPath As String = "C:\temp\excelmap\data") Dim fso As New FileSystemObject Dim sourceWb As Workbook Dim targetWb As Workbook Dim myFile As File On Error GoTo err_handler 'Ziel-Workbook setzen Set targetWb = ActiveWorkbook 'jede Datei im Ordner öffen und das erste Worksheet kopieren For Each myFile In fso.GetFolder(sourceFolderPath).Files Set sourceWb = Workbooks.Open(myFile.path) Call sourceWb.Worksheets(1).Copy(after:=targetWb.Sheets(targetWb.Sheets.Count)) Call sourceWb.Close Next exit_handeler: 'Aufräumen Set sourceWb = Nothing Set targetWb = Nothing Set myFile = Nothing Set fso = Nothing Exit Function err_handler: Call msgbox(Err.Description) GoSub exit_handler End Function und noch eine Abwandlung um ein bestimmtes Sheet eines Workbooks zu importieren '/** ' * Importiert ein Worksheet ' * @param Worksheet-Pfad ' * @param optional WS-Index ' */ Public Function importWs(sourceFilePath As String, optional wsIndex as Variant = 0) Dim sourceWb As Workbook Dim targetWb As Workbook On Error GoTo err_handler 'Ziel-Workbook setzen Set targetWb = ActiveWorkbook Set sourceWb = Workbooks.Open(sourceFilePath) Call sourceWb.Worksheets(wsIndex).Copy(after:=targetWb.Sheets(targetWb.Sheets.Count)) exit_handeler: On Error resume next 'Aufräumen Call sourceWb.Close Set sourceWb = Nothing Set targetWb = Nothing Exit Function err_handler: Call msgbox(Err.Description) GoSub exit_handler End Function {{tag>VBA MS_Excel}}