zu kopierenden Bereich erweitern

Sub finden()
'Dieses Makro schreibt den Datensatz aus Suchbegriff in Tabelle1 A1 in die Zieltabelle Tabelle3
'by Ramses
'Sucht in der gesamten Mappe nach einem Begriff und kopiert die
'gefundene Zeile in eine zu definfierende Ergebnistabelle
Dim wks As Worksheet
Dim rng As Range
Dim sAddress As String
'Suchbegriff
Dim sFind As Variant
Dim cr As Long, tarWks As String
'Name_der_Zieltabelle
'Bitte Anpassen !!!!
tarWks = "Tabelle3"
Debug.Print tarWks
cr = 65536
If Worksheets(tarWks).Cells(cr, 3) = "" Then
cr = Worksheets(tarWks).Cells(cr, 3).End(xlUp).Row
Debug.Print cr
End If
If cr = 0 Then cr = 1
'Suchbegriff definieren
'sFind = InputBox("Bitte Suchbegriff eingeben:")           'Suchbegriff in eine InputBox  _
eingeben
'If sFind = "" Then Exit Sub
'Suchbegriff auf Zelle definieren
sFind = Worksheets("Tabelle1").Range("A1")                 'Suchbegriff in eine Zelle eingeben
Debug.Print sFind
Debug.Print wks
Set wks = ThisWorkbook.Worksheets("Tabelle1")              'Suchtabelle definieren
'For Each wks In Worksheets                                'für alle Tebellen in Datei
If wks.Name = tarWks Then Exit Sub
Debug.Print wks.Name
Set rng = wks.Range("c10:" & wks.Cells(wks.Rows.Count, Columns.Count).Address).Find( _
What:=sFind, LookAt:=xlPart, LookIn:=xlFormulas)
If Not rng Is Nothing Then
sAddress = rng.Address
Debug.Print sAdresse
Do
Application.Goto rng, True
'Für die Automation kann die "If"-Anweisung auskommentiert werden
' If MsgBox("Suchbegriff: " & sFind & ",gefunden in " & wks.Name & ", " & rng.  _
Address, vbYesNo + vbQuestion, "Weitersuchen ?") = vbNo Then Exit Sub
wks.Rows(rng.Row).Copy Destination:=Worksheets(tarWks).Rows(cr)
'ab hier komme ich nicht mehr weiter
'wks.Rows (rng.Row): & activesheet.range("B1:E1).Copy Destination:=Worksheets( _
tarWks).Row(cr)
'oder diese Anweisungen nach der Codezeile  "wks.Rows(rng.Row).Copy Destination:= _
Worksheets(tarWks).Rows(cr)"
'ActiveCell.Offset(0, 1).Activate
'Sheets("Tabelle1").Range("A2").Copy
'Sheets("Tabelle3").Range(ActiveCell).PasteSpecial Paste:=xlPasteValues
'funktionieren bei mir nicht was mache ich falsch?
kann mir einer den Code so anpassen, das in meinem Fall zusätzlich ab Spalte D in der aktiven  _
Zeile der Bereich aus Tabelle1 B1:E1 mit kopiert und eingefügt wird.
Zur besseren Verständigung: die Zellen B1:E1 werden entsprechend des Suchbegriffes aus Tabelle1  _
A1 variabel angepasst um später mit den Daten weiter arbeiten zu können.
Debug.Print cr
cr = cr + 1                                'Zeilennummer wird um 1 hochgezählt zB.  _
C10 wird dann C11 usw.
Debug.Print rng
Set rng = wks.Range("c10:" & wks.Cells(wks.Rows.Count, Columns.Count).Address). _
FindNext(After:=ActiveCell)
'Debug.Print rng.adresse
If rng.Address = sAddress Then Exit Do     'wenn im Bereich Tabelle1 ab C10 Wert  _
mit gesuchten Wert aus Tabelle1 A1 übereinstimmt dann weiter mit Loop sonst Exit
Loop
End If
'NextStart:
'Next wks
'MsgBox prompt:="Keine neue Fundstelle!"
wks.Cells(1, 1).Activate
End Sub