| Arbeitsblatt mit dem Namen 'Tabelle2' | |||||||
| A | B | C | D | E | F | G | |
| 1 | Dat | Zt | T1 | T2 | T3 | T4 | T5 |
| 2 | 01.01.2026 | 14:20 | A | 1 | 3 | ||
| 3 | 01.01.2026 | 12:20 | b | 2 | 33 | ||
| 4 | 02.01.2026 | 14:20 | c | 3 | 333 | ||
| 5 | 03.01.2026 | 15:20 | d | 4 | 3333 | ||
| Arbeitsblatt mit dem Namen 'Tabelle1' | ||||
| A | B | C | D | |
| 1 | U1 | |||
| 2 | ||||
| 3 | ||||
| 4 | ||||
| 5 | ||||
| 6 | 01.01.2026 14:20 | |||
| 7 | 01.01.2026 12:20 | |||
| 8 | 03.01.2026 15:20 | |||
Sub Datenabgleich_Schluessel()
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim wbZiel As Workbook, wksZiel As Worksheet
Dim varSchluessel, lSpalteSchluessel As Long, Zelle As Range
Dim ZeileQuelle As Long, ZeileZiel As Long
Dim LC As Integer
' Tabelle mit ggf. neuen Daten
Set wbQuelle = Workbooks("MappeDaten.xlsx") ' Name anpassen!
Set wksQuelle = wbQuelle.Worksheets("Tabelle2") ' Name anpassen
' Tabelle in der Inhalte eingetragen werden sollen
Set wbZiel = Workbooks("MappeZiel.xlsx") ' Name anpassen!
Set wksZiel = wbZiel.Worksheets("Tabelle1") ' Name anpassen
' Nr. der Schlüsselspalte
lSpalteSchluessel = 1 ' ggf. anpassen
' Letzte Spalte Quelle ermitteln
LC = wksQuelle.Cells.SpecialCells(xlCellTypeLastCell).Column 'Letzte Spalte des gesamten Blattes
LC = LC - lSpalteSchluessel
' Letzte Datenzeile in Zieltabelle
With wksZiel
ZeileZiel = .Cells(.Rows.Count, lSpalteSchluessel).End(xlUp).Row
End With
Application.ScreenUpdating = False
With wksQuelle
For ZeileQuelle = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
' Such-Werte aus Zeile in Zieltabelle einlesen
varSchluessel = CDate(.Cells(ZeileQuelle, lSpalteSchluessel) + .Cells(ZeileQuelle, lSpalteSchluessel + 1))
' Name in Spalte Schlüsselsäule im Zieltabelle suchen
Set Zelle = wksZiel.Columns(lSpalteSchluessel).Find(what:=varSchluessel, _
LookIn:=xlFormulas2, LookAt:=xlPart)
If Zelle Is Nothing Then ' neuer Datensatz
ZeileZiel = ZeileZiel + 1
'Spalte Datum und Zeit adiert einfügen
wksZiel.Cells(ZeileZiel, 1).Value = varSchluessel
'Restliche Daten ab Spalte 3 in Spalte2 und folgende einfügen
wksZiel.Cells(ZeileZiel, 2).Resize(1, LC).Value = _
.Cells(ZeileQuelle, lSpalteSchluessel + 2).Resize(1, LC).Value
End If
Next
End With
Application.ScreenUpdating = True
End Sub
Sub Datenabgleich_Schluessel()
Dim wbQuelle As Workbook, wksQuelle As Worksheet
Dim wbZiel As Workbook, wksZiel As Worksheet
Dim varSchluessel, lSpalteSchluessel As Long, Zelle As Range
Dim ZeileQuelle As Long, ZeileZiel As Long
' Tabelle mit ggf. neuen Daten
Set wbQuelle = Workbooks("MappeDaten.xls") ' Name anpassen!
Set wksQuelle = wbQuelle.Worksheets("Tabelle2") ' Name anpassen
' Tabelle in der Inhalte eingetragen werden sollen
Set wbZiel = Workbooks("MappeZiel.xls") ' Name anpassen!
Set wksZiel = wbZiel.Worksheets("Tabelle1") ' Name anpassen
' Nr. der Schlüsselspalte
lSpalteSchluessel = 1 ' ggf. anpassen
' Letzte Datenzeile in Zieltabelle
With wksZiel
ZeileZiel = .Cells(.Rows.Count, lSpalteSchluessel).End(xlUp).Row
End With
Application.ScreenUpdating = False
With wksQuelle
For ZeileQuelle = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
' Such-Werte aus Zeile in Zieltabelle einlesen
varSchluessel = .Cells(ZeileQuelle, lSpalteSchluessel)
' Name in Spalte Schlüsselsäule im Zieltabelle suchen
Set Zelle = wksZiel.Columns(lSpalteSchluessel).Find(what:=varSchluessel, _
LookIn:=xlValues, lookat:=xlWhole)
If Zelle Is Nothing Then ' neuer Datensatz
ZeileZiel = ZeileZiel + 1
.Rows(ZeileQuelle).Copy
wksZiel.Cells(ZeileZiel, 1).PasteSpecial Paste:=xlPasteValues
End If
Next
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub