Hallo Gast82527,
zunächst mal danke für die zeitnahe Rückmeldung. Ich bin leider erst heute dazu gekomen, den Code zu testen. Bei mir funktioniert allerdings der Kopiervorgang nicht wirklich. Er öffnet die Datei und hört dann aber auf, ohne jegliche Daten zu kopieren und in die Zusammenfassungsdatei einzufügen..
Ich habe die Wörter, zwischen denen sich die Range befinden soll geändert auf "Datum" und "Gesamtergebnis".
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
Dies ist mein aktueller Code.
Hast du eine Idee woran es liegen könnte?
Gruß
Michael
|