Sub SheetsImport()
Dim Dlg As FileDialog, Wks As Worksheet, i As Integer
Set Wks = Workbooks(ImportDatei).Sheets(1): Wks.Cells.Clear
Set Dlg = Application.FileDialog(msoFileDialogOpen)
With Dlg
.InitialFileName = "C:\Users\Michael\Desktop\Zusammenfassung_Rechnung"
.Filters.Clear
.Filters.Add "Excel Dateien", "*.xls*", 1
.Show
End With
DlgNext:
If Dlg.Show = False Then Exit Sub
For i = 1 To Dlg.SelectedItems.Count
Call SheetsInsert(Wks, Dlg.SelectedItems(i))
Next
GoTo DlgNext
____________________________________________________________
End Sub
Private Sub SheetsInsert(ByRef Wks, ByRef Path)
Dim xWkb As Workbook
Dim xWks As Worksheet
Dim LastLine As Range
Dim FirstLine As Range
Dim Range As Integer
Application.ScreenUpdating = False
Set xWkb = Workbooks.Open(Path): Set xWks = xWkb.Sheets(1)
With xWkb.Sheets(1).UsedRange
Set FirstLine = .Find("Datum", , xlValues, xlWhole)
Set LastLine = .Find("Gesamtergebnis", , xlValues, xlWhole)
If (Not FirstLine Is Nothing) And (Not LastLine Is Nothing) Then
Rows(FirstLine.Offset(1).Row & ":" & LastLine.Offset(-1).Row).Copy Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
End With