Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1140to1144
1140to1144
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro: Tabellen zusammenführen mit WENN abfrage

Forumthread: Makro: Tabellen zusammenführen mit WENN abfrage

Makro: Tabellen zusammenführen mit WENN abfrage
Tatü
Hallo Forum.
Ich brauche ein Makro, dass Zeilen aus zwei Tabellen(Tabelle 1+2) in eine dritte(Tabelle3) zusammenfügt.
Zusammengefügt sollen alle Zeilen(ab der Zeile3), die in der Spalte D den Wert WAHR haben.
Zu beiden Tabellen kommen weitere Zeilen hinzu.
Daher muss die Abfrage in beiden Tabellen bis zu letzten gefüllten Zeile in der Spalte D erfolgen.
DANKE, schon mal im voraus!
tatü
Anzeige

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
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
Anzeige
AW: Tabellen zusammenführen mit WENN abfrage
22.02.2010 17:08:44
Tatü
Super, danke. Es läuft!
tatü

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige