AW: Werte von Tabelle 2 zu Tabelle 1 addieren
25.06.2008 00:05:27
Tabelle
Hallo Sascha,
hier mein Vorschlag
Gruß
Franz
Sub Tabelle2nach1Einlesen()
Dim wksZiel As Worksheet, wksQuelle As Worksheet
Dim lngZeileQ As Long, lngSpalte As Long
Dim rngArtikel As Range
Dim varArtikel
If MsgBox("Soll der Bestand aus Tabelle2 nach Tabelle1 eingelesen werden?", _
vbOKCancel, "Datenübernahem aus Tabelle 2 nach 1") = vbOK Then
Set wksZiel = Worksheets("Tabelle1")
Set wksQuelle = Worksheets("Tabelle2")
With wksQuelle
For lngZeileQ = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
varArtikel = .Cells(lngZeileQ, 1).Value
'Artikel in Spalte eins der Zieltabelle suchen
Set rngArtikel = wksZiel.Columns(1).Find(what:=varArtikel, LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=False)
If rngArtikel Is Nothing Then
'nächste freie Zeile in Spalte A der Zieltabelle wählen
With wksZiel
Set rngArtikel = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
'Alle Daten des Artikels aus Quelltabelle übernehmen
rngArtikel.Value = varArtikel
For lngSpalte = 2 To 8 'Spalte B bis H
rngArtikel.Offset(0, lngSpalte - 1) = .Cells(lngZeileQ, lngSpalte).Value
Next
Else
'Bestand aus Tabelle 2 zum Bestand in Tabelle 1 addieren
rngArtikel.Offset(0, 6) = rngArtikel.Offset(0, 6) _
+ .Cells(lngZeileQ, 7).Value
End If
Next
End With
End If
Set wksZiel = Nothing: Set wksQuelle = Nothing
Set rngArtikel = Nothing
End Sub