AW: Tabellen zusammenführen mit WENN abfrage
21.02.2010 21:51:29
JOWE
Hallo tatü tata
Sub verschmelzen()
Dim shA, shB, shC As Worksheet
Set shA = Sheets("Tabelle1")
Set shB = Sheets("Tabelle2")
Set shC = Sheets("Tabelle3")
With shA.Range("D3:D" & shA.Range("A65536").End(xlUp).Row)
Set c = .Find(True, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
lzC = shC.Range("A65536").End(xlUp).Row + 1
shA.Range(shA.Cells(c.Row, 1), shA.Cells(c.Row, 4)). _
Copy Destination:=shC.Cells(lzC, 1)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address firstAddress
End If
End With
With shB.Range("D3:D" & shB.Range("A65536").End(xlUp).Row)
Set c = .Find(True, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
lzC = shC.Range("A65536").End(xlUp).Row + 1
shB.Range(shB.Cells(c.Row, 1), shB.Cells(c.Row, 4)). _
Copy Destination:=shC.Cells(lzC, 1)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address firstAddress
End If
End With
End Sub
Gruß
Jochen