Tabellenblätter nach Begriffen durchsuchen
28.10.2015 09:59:39
Christian
folgenden Code nutze ich um bestimmte Zellwerten aus einem Sheet in ein anderes zu kopieren. Dabei wird in Tabelle1, Spalte A, vorab nach einem bestimmten Begriff gesucht und nur die entsprechenden Zeilen kopiert. Dieser Code funktioniert soweit wunderbar.
Private Sub Klick_Click()
Dim wksSrc As Worksheet, wksDst As Worksheet
Dim lRowSrc As Long, fRowDst As Long
Dim c As Range
With ThisWorkbook
Set wksSrc = .Sheets("Tabelle1")
Set wksDst = .Sheets("Tabelle2")
lRowSrc = wksSrc.Cells(Rows.Count, 1).End(xlUp).Row
For Each c In wksSrc.Range("A1:A" & lRowSrc)
If c = "abc" Then
With wksDst
fRowDst = .Cells(Rows.Count, 1).End(xlUp).Row + 1
c.Copy
.Cells(fRowDst, 1).PasteSpecial Paste:=xlPasteValues
c.Offset(0, 1).Copy
.Cells(fRowDst, 2).PasteSpecial Paste:=xlPasteValues
c.Offset(0, 6).Copy
.Cells(fRowDst, 3).PasteSpecial Paste:=xlPasteValues
End With
End If
Next c
End With
Application.CutCopyMode = False
End Sub
Nun soll der Code um folgendes erweitert werden:
In zwei weiteren Tabellenblättern (Tabelle3 und Tabelle4) soll quasi eine gleiche Abfrage passieren, nur sollen die entsprechenden Zellwerte untereinander aufgelistet werden.
Zusammengefasst soll der Code folgendes machen:
1. Durchsuche in Tabelle 1 Spalte A nach dem Begriff abc und kopiere die einzelnen Ergebnisse in Tabelle 2
2. Durchsuche in Tabelle 3 Spalte A nach dem Begriff def und kopiere die einzelnen Ergebnisse in Tabelle 2 unter die schon vorhandenen Ergebnisse
3. Durchsuche in Tabelle 4 Spalte A nach dem Begriff ghi und kopiere die einzelnen Ergebnisse in Tabelle 2 unter die schon vorhandenen Ergebnisse
Ich würde das alle gerne in einer Abfrage haben und nicht drei verschiedene erstellen.
Vielen Dank für die Hilfe.
Anzeige