======[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}}