Zelle suchen + umliegenden Bereich in neue Tabelle
17.02.2009 15:51:00
Schulze
ich bräuchte ein Makro, welches mir nach einem bestimmten Suchwort jede Zelle ausliest und diesen Inhalt mit einem darüber und darunter liegenden Bereich in die Tabelle2 untereinander kopiert.
Das Suchwort kommt natürlich in der Tabelle 1 Bereich A1:A65536 mehrmals vor.
Weiß nicht wo mein Fehler liegt.
Vorab schonmal vielen Dank.
Sub BedingtesKopieren()
Dim Zeile As Long
Dim Zeile2 As Range
Dim ZeileMax As Long
Dim i As Long
With Tabelle1
ZeileMax = .UsedRange.Rows.Count
i = 1
For Zeile = 2 To ZeileMax
If .Cells(Zeile, 1).Value = "VERBINDUNG" Then
Range(Zeile1.Offset(-10, 0), Zeile1.Offset(1, 5)).Copy Destination:=Tabelle2.Rows(i)
i = i + 1
End If
Next Zeile
End With
End Sub
Anzeige