Hallo Tobi,
Du hast leider nicht mitgeteilt, wie Deine Blätter
gefüllt werden. Werden neue Artikelnummern zuerst
nur in Blatt A eingegeben? Oder auch gleich in B?
Gibt es Lücken in den Zeilen in A oder in B?
Ich bin einmal davon ausgegangen, daß neue Artikel-
nummern nur in A angefügt werden, sodaß beim Copy
von A nach B in Blatt B die fehlenden Zeilen ergänzt
werden. Ist das nicht der Fall, muß im zweiten Makro
der gesamte ElseIf-Zweig wegfallen.
Hier die Makros, ich habe sie A_nach_B und B_nach_A
genannt, ändere die Namen nach Geschmack und kopiere
den Code in einen Modul. (a propos: im Duden heißt
es noch immer DER Modul, auch wenn MS samt seiner
Epigonenliteratur DAS Modul schreibt…)
Option Explicit
Sub B\_nach\_A()
Dim Quelle As Worksheet, Ziel As Worksheet
Dim q As Long, z As Long, i As Long, j As Long
'Hier legst Du Deine Daten fest
Const TblA As String = "Tabelle A"
Const TblB As String = "Tabelle B"
Const AnfA As Integer = 13 '1. Zeile in Tabelle A
Const AnfB As Integer = 4 '1. Zeile in Tabelle B
Const KomA As Integer = 15 'Spalte O in Tabelle A
Const KomB As Integer = 3 'Spalte C in Tabelle B
Const EntA As Integer = 16 'Spalte P in Tabelle A
Const EntB As Integer = 4 'Spalte D in Tabelle B
On Error Resume Next
Application.ScreenUpdating = False
Set Quelle = ActiveWorkbook.Sheets(TblB)
Set Ziel = ActiveWorkbook.Sheets(TblA)
'Letzte Zeile in Tabelle A:
Quelle.Activate
q = Quelle.Range("A65535").End(xlUp).Row
'Letzte Zeile in Tabelle B:
Ziel.Activate
z = Ziel.Range("A65535").End(xlUp).Row
'Übertrag:
For i = AnfB To q
For j = AnfA To z
If Ziel.Cells(j, 1).Value = Quelle.Cells(i, 1).Value Then
Ziel.Cells(j, KomA).Value = Quelle.Cells(i, KomB).Value
Ziel.Cells(j, EntA).Value = Quelle.Cells(i, EntB).Value
End If
Next j
Next i
Application.ScreenUpdating = True
Ziel.Activate
Set Quelle = Nothing
Set Ziel = Nothing
End Sub
Sub A\_nach\_B()
Dim Quelle As Worksheet, Ziel As Worksheet
Dim q As Long, z As Long, i As Long, j As Long, max As Integer
Const TblA As String = "Tabelle A"
Const TblB As String = "Tabelle B"
Const AnfA As Integer = 13
Const AnfB As Integer = 4
Const KomA As Integer = 15
Const KomB As Integer = 3
Const EntA As Integer = 16
Const EntB As Integer = 4
On Error Resume Next
Application.ScreenUpdating = False
Set Quelle = ActiveWorkbook.Sheets(TblA)
Set Ziel = ActiveWorkbook.Sheets(TblB)
Quelle.Activate
q = Quelle.Range("A65535").End(xlUp).Row
Ziel.Activate
z = Ziel.Range("A65535").End(xlUp).Row
max = q + AnfB - AnfA
For i = AnfA To q
For j = AnfB To max
If Ziel.Cells(j, 1).Value = Quelle.Cells(i, 1).Value Then
Ziel.Cells(j, KomB).Value = Quelle.Cells(i, KomA).Value
Ziel.Cells(j, EntB).Value = Quelle.Cells(i, EntA).Value
'ggf neue Zeilen aus A in B anfügen:
ElseIf (i - AnfA \> z - AnfB) And (Ziel.Cells(j, 1).Value = "") Then
Ziel.Cells(j, 1).Value = Quelle.Cells(i, 1).Value
Ziel.Cells(j, KomB).Value = Quelle.Cells(i, KomA).Value
Ziel.Cells(j, EntB).Value = Quelle.Cells(i, EntA).Value
Exit For
End If
Next j
Next i
Application.ScreenUpdating = True
Ziel.Activate
Set Quelle = Nothing
Set Ziel = Nothing
End Sub
Wenn Lücken in den Zeilen vorhanden sind, funktioniert
der Code nicht. In diesem Fall melde Dich bitte noch
einmal mit genauen Angaben. Um ev. Änderungen im Tabellen-
aufbau zu verkraften, sind alle Daten als Konstante de-
klariert, die Du bei Bedarf leicht anpassen kannst.
Frohe Ostern!
gs
