Vermeidung doppelter Datensätze beim Kopieren
19.12.2017 15:26:54
Pat
Dank UweD habe ich eine Möglichkeit gefunden, dass ein Makro aus einem bestimmten Ordner alle Excel Dateien anspricht und die Daten aus den jeweiligen Tabelle1 (ab Zeile 2) in eine MasterTabelle 1 hinein kopiert.
Zudem werden die Daten in der MasterTabelle1 automatisch in der nächst freien Zeile eingefügt.
Hier der Code dafür:
Sub alle_Dateien_Verzeichnis2() '
On Error GoTo Fehler
Dim Pfad$, Ext$, Datei$, TB1, TB2, LR1 As Double, LR2 As Double
Dim SP As Integer, EZ As Integer, XZeilen As Integer, MaxZeilen As Integer
Ext = "*.xl*"
Pfad = "X:\Temp\Test\" '**** mit \
Set TB1 = ThisWorkbook.Sheets("MasterTabelle1") 'das Sammelblatt
SP = 1 'erste Datenspalte
EZ = 2 'Ab Zeile2 / wegen Überschriften
XZeilen = 7 ' letzen x Zeilen
Datei = Dir(Pfad & Ext)
Do While Len(Datei) > 0
Workbooks.Open Filename:=Pfad & Datei
Set TB2 = ActiveWorkbook.Sheets("Tabelle1")
LR1 = TB1.Cells(TB1.Rows.Count, SP).End(xlUp).Row 'letzte Zeile der Spalte
LR2 = TB2.Cells(TB2.Rows.Count, SP).End(xlUp).Row
'alle Daten kopieren
TB1.Rows(LR1 + 1).Resize(LR2 - EZ + 1).Value = _
TB2.Rows(EZ).Resize(LR2 - EZ + 1).Value
Workbooks(Datei).Close False 'schliessen ohne speichern
Datei = Dir() ' nächste Datei
Loop
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & _
Err.Number & vbLf & Err.Description: Err.Clear
End Sub
Habe 3 Test-Excel-Dateien angelegt und eine MasterDatei. (Der Pfad zum Ornder muss benutzerspez. geändert werden)
Hier die gezipten Dateien: https://www.herber.de/bbs/user/118416.zip
Vielen Dank für deine bisherige Hilfe, Uwe! Vielleicht kann mir wer weiterhelfen