Daten aus Tabellen kopieren
29.09.2022 15:50:54
Bucher
Nach dem Debuggen wird diese Zeile "LetzteZeile = ThisWorkbook.Worksheets(2).Cells(Rows.Count, 2).End(x1UP).Row" gelb unterlegt.
Ich habe eine Arbeitsmappe(Datei) mit einer Tabelle.
Die soll immer wieder mit Daten aus mehreren anderer Tabellen ergänzt werden.
Die Tabellen sind alle gleich aufgebaut.
Wo liegt der Fehler?
Sub Mehrere_Daten_kopieren()
Dim Arrdateien As Variant
Dim wbQuelle As Workbook
Dim LetzteZeile As Long
Dim cntDatei As Long
'Screeupdating und PopUps deaktivieren
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Benutzer Dateien auswählen lassen
Arrdateien = Application.GetOpenFilename(FileFilter:="Excel-Dateien (*.xls*),*.xls*", MultiSelect:=True)
'wurde eine Datei ausgewählt
If IsArray(Arrdateien) Then
'Schleife über alle ausgewählten Dateien
For cntDatei = 1 To UBound(Arrdateien)
LetzteZeile = ThisWorkbook.Worksheets(2).Cells(Rows.Count, 2).End(x1UP).Row
'Aktuelle Arbeitsmappe öffnen
Set wbQuelle = wokbooks.Open(Filename:=Arrdateien(cntDatei))
'Dateien kopieren und einfügen
wbQuelle.Worksheets(8).Range("A2:AD2").Copy
ThisWorkbook.Worksheets(8).Range("A" & LetzteZeile + 1).PasteSpecial
'Arbeitsmappe schliessen
wbQuelle.Close savechanges:=False
Next cntDatei
End If
'Screeupdating und PopUps aktivieren
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Anzeige