in einer Mappe befinden sich 3 Tabellenblätter; Gesamt, Grunddaten und Altdaten - In Gesamt werden unterschiedlich viele Daten, die aber alle immer das Format zu Tabelle Grund- und Altdaten haben, eingespielt. Im beiliegenden Code, wenn ich ihn richtig interpretiere, werden Veränderungen zwischen dem einen und dem anderen Tabellenblatt automatisch übertragen. Wie müßte der Code, der am liebsten über Schaltfläche funktionieren sollte, abgeändert werden, damit ein Abgleich von "Gesamt" zu Altdaten und Grunddaten erfolgen kann. - Also, alle Veränderungen/Eintragungen in Spalte I:K von "Gesamt" sollten zu Alt- und Grunddaten übertragen werden (dabei allerdings immer auch zum richtigen Schlüssel bzw. in die richtige Zeile). Schlüssel ist die Spalte D (Kundennummer und somit einmalig). - Danke schon jetzt wieder für die Rückmeldungen.
Herzliche Grüße
Wolfgang
Hier der I. Code aus dem Beispiel (hinter Worksheets "Tab1")
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim wks1 As Worksheet, wks2 As Worksheet, Finden As Range
Dim SpS1 As Long, SpS2 As Long, Sp As Long
Set wks1 = ThisWorkbook.Sheets("Tab1")
Set wks2 = ThisWorkbook.Sheets("Tab2")
SpS1 = 1 'Spalte mit Schlüsselsfeldern in Blatt 1
SpS2 = 1 'Spalte mit Schlüsselsfeldern in Blatt 2
If Target.Column = 2 Then 'Spalte in Blatt 1
Sp = 2 'ensprechende Spalte in Blatt 2
Set Finden = wks2.Columns.Find(What:=wks1.Cells(Target.Row, SpS1), LookIn:=xlValues, Lookat: _
=xlWhole)
If Finden Is Nothing Then
If MsgBox("Schlüssel in Tabelle " & wks2.Name & " nicht vorhanden." & vbLf & vbLf _
& "Zeile in" & wks2.Name & " einfügen?", vbYesNo, "Tabellenabgleich") = vbYes Then
Call ZeilenDatenuebertragen1(wks1, wks2, Target.Row, SpS2)
End If
Else
If wks2.Cells(Finden.Row, Sp).Value Target.Value Then
wks2.Cells(Finden.Row, Sp).Value = Target.Value
End If
End If
End If
If Target.Column = 3 Then 'Spalte in Blatt 1
Sp = 4 'ensprechende Spalte in Blatt 2
Set Finden = wks2.Columns.Find(What:=wks1.Cells(Target.Row, SpS1), LookIn:=xlValues, Lookat: _
=xlWhole)
If Finden Is Nothing Then
If MsgBox("Schlüssel in Tabelle " & wks2.Name & " nicht vorhanden." & vbLf & vbLf _
& "Zeile in" & wks2.Name & " einfügen?", vbYesNo, "Tabellenabgleich") = vbYes Then
Call ZeilenDatenuebertragen1(wks1, wks2, Target.Row, SpS2)
End If
Else
If wks2.Cells(Finden.Row, Sp).Value Target.Value Then
wks2.Cells(Finden.Row, Sp).Value = Target.Value
End If
End If
End If
End Sub
Sub ZeilenDatenuebertragen1(Blatt1 As Worksheet, Blatt2 As Worksheet, Zeile1 As Long, SpS2 As Long)
' Fügt Daten einer Zeile aus Blatt1 in Blatt2 am Ende ein
Dim Zeile2 As Long
Zeile2 = Blatt2.Cells(65000, SpS2).End(xlUp).Row + 1 'nächste leere Zeile in Blatt 2
Blatt2.Cells(Zeile2, 1).Value = Blatt1.Cells(Zeile1, 1).Value
Blatt2.Cells(Zeile2, 2).Value = Blatt1.Cells(Zeile1, 2).Value
Blatt2.Cells(Zeile2, 4).Value = Blatt1.Cells(Zeile1, 3).Value
End Sub
Und hier der Code aus Tab2
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim wks1 As Worksheet, wks2 As Worksheet, Finden As Range
Dim SpS1 As Long, SpS2 As Long, Sp As Long
Set wks1 = ThisWorkbook.Sheets("Tab1")
Set wks2 = ThisWorkbook.Sheets("Tab2")
SpS1 = 1 'Spalte mit Schlüsselsfeldern in Blatt 1
SpS2 = 1 'Spalte mit Schlüsselsfeldern in Blatt 2
If Target.Column = 2 Then 'Spalte in Blatt 2
Sp = 2 'ensprechende Spalte in Blatt 1
Set Finden = wks1.Columns.Find(What:=wks2.Cells(Target.Row, SpS2), LookIn:=xlValues, Lookat: _
=xlWhole)
If Finden Is Nothing Then
If MsgBox("Schlüssel in Tabelle " & wks1.Name & " nicht vorhanden." & vbLf & vbLf _
& "Zeile in" & wks1.Name & " einfügen?", vbYesNo, "Tabellenabgleich") = vbYes Then
Call ZeilenDatenuebertragen2(wks1, wks2, Target.Row, SpS1)
End If
Else
If wks1.Cells(Finden.Row, Sp).Value Target.Value Then
wks1.Cells(Finden.Row, Sp).Value = Target.Value
End If
End If
End If
If Target.Column = 4 Then 'Spalte in Blatt 2
Sp = 3 'ensprechende Spalte in Blatt 1
Set Finden = wks1.Columns.Find(What:=wks2.Cells(Target.Row, SpS2), LookIn:=xlValues, Lookat: _
=xlWhole)
If Finden Is Nothing Then
If MsgBox("Schlüssel in Tabelle " & wks1.Name & " nicht vorhanden." & vbLf & vbLf _
& "Zeile in" & wks1.Name & " einfügen?", vbYesNo, "Tabellenabgleich") = vbYes Then
Call ZeilenDatenuebertragen2(wks1, wks2, Target.Row, SpS1)
End If
Else
If wks1.Cells(Finden.Row, Sp).Value Target.Value Then
wks1.Cells(Finden.Row, Sp).Value = Target.Value
End If
End If
End If
End Sub
Sub ZeilenDatenuebertragen2(Blatt1 As Worksheet, Blatt2 As Worksheet, Zeile2 As Long, SpS1 As Long)
' Fügt Daten einer Zeile aus Blatt2 in Blatt1 am Ende ein
Dim Zeile1 As Long
Zeile1 = Blatt1.Cells(65000, SpS1).End(xlUp).Row + 1 'nächste leere Zeile in Blatt 2
Blatt1.Cells(Zeile1, 1).Value = Blatt2.Cells(Zeile2, 1).Value
Blatt1.Cells(Zeile1, 2).Value = Blatt2.Cells(Zeile2, 2).Value
Blatt1.Cells(Zeile1, 3).Value = Blatt2.Cells(Zeile2, 4).Value
End Sub