Daten einlesen

Public Sub ImportReports()

Dim intChoice As Integer

Dim strPath As String

Dim i As Integer

'allow the user to select multiple files

Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = True

Application.FileDialog(msoFileDialogOpen).Title = "Bitte wählen Sie die Berichte aus..."
Application.FileDialog(msoFileDialogOpen).Filters.Clear

Application.FileDialog(msoFileDialogOpen).Filters.Add "Excel 2010", "*.xlsm"

'make the file dialog visible to the user

intChoice = Application.FileDialog(msoFileDialogOpen).Show

'determine what choice the user made

If intChoice  0 Then

'get the file path selected by the user

Application.ScreenUpdating = False

Application.DisplayAlerts = False

For i = 1 To Application.FileDialog(msoFileDialogOpen).SelectedItems.Count

strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(i)

'print the file path to sheet 1

'Cells(i + 1, 1) = strPath

Import strPath

Next i

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End If

End Sub

Public Sub Import(strPath As String)

Dim wb As Workbook

Dim sht As Worksheet

Dim lastrow As Long

Dim activeWb As Workbook

Dim masterSht As Worksheet

Dim i As Integer

Set activeWb = ThisWorkbook

Set masterSht = activeWb.Worksheets("Rohdaten")

lastrow = masterSht.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile Spalte 1

Set wb = Workbooks.Open(strPath)

For i = 1 To 7

Set sht = wb.Sheets(i)

sht.Range("A4:T" & sht.Cells(Rows.Count, "A").End(xlUp).Row).Copy

lastrow = masterSht.Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile Spalte 1

masterSht.Range("A" & lastrow + 1).PasteSpecial Paste:=xlPasteValues, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False

Application.CutCopyMode = False

Next i

wb.Close

End Sub