Makro
Günter
hätte eine Bitte zu folgendem Makro:
Das Makro aus der Vorgabe Tabelle 3 (Spalte A) in der Tabelle 1 (Spalte A)
nach Begriffen und markiert mir diese in Tabelle 1 in gelb.
Gleichzeit schreibt mir das Makro die gefundenen Begriffe in Tabelle 2, aber leider
nur den Inhalt aus Spalte A und B von Tabelle 1.
Meine Bitte: Wie kann man dies Umschreiben, damit nicht nur der Inhalt Spalte A und B
aus Tabelle 1, sondern die ganzen Spalten (bis Spalte Z) aus Tabelle 1 in Tabelle 2 rein geschrieben
werden.
Schönen Gruß
PS: Wollte Beispieldatei hochladen. Ist scheinbar zu groß 1.7 mb, obwohl ganz wendige Daten drin sind.
Sub SuchenMarkieren_ganze_Wörter()
Dim col As New Collection
Dim iRowS As Long, iRow As Long, iRowT As Long
Dim arrG
Dim arrL
Dim Zaehler As Integer
Dim Zeile As Integer
col.Add Worksheets("Tabelle1")
col.Add Worksheets("Tabelle2")
col.Add Worksheets("Tabelle3")
iRow = 1
Do Until IsEmpty(col(3).Cells(iRow, 1))
iRowS = 1
Do Until IsEmpty(col(1).Cells(iRowS, 1))
If InStr(col(1).Cells(iRowS, 1).Value, col(3).Cells(iRow, 1).Value) Then
' If InStr(LCase(col(1).Cells(iRowS, 1).Value), LCase(col(3).Cells(iRow, 1).Value)) _
Then
iRowT = iRowT + 1
col(2).Range(col(2).Cells(iRowT, 1), col(2).Cells(iRowT, 2)).Value = _
col(1).Range(col(1).Cells(iRowS, 1), col(1).Cells(iRowS, 2)).Value
col(1).Cells(iRowS, 1).Interior.ColorIndex = 6
End If
iRowS = iRowS + 1
Loop
iRow = iRow + 1
Loop
Columns("A:A").Select
Selection.NumberFormat = "General"
Range("A1").Select
Columns("B:B").Select
Selection.NumberFormat = "0"
Range("B1").Select
'Sortieren
Columns("A:B").Select
Range("B1").Activate
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A1").Select
MsgBox "Fertig!!"
End Sub