'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