Suchen und Kopieren

[MarkBrand]

Hallo und Moin Moin,

Ich hab schon einige Probleme gelöst aber komme mit einem Stück nicht weiter. Ich möchte in einer Tabelle (welche ich mit VBA aus dem Netzwerk ziehe) einige Daten suchen und in einer weiteren Tabelle kopieren im dem selben Workbook.

Ich bin schon ziemlich weit aber brauche noch ein wenig Hilfe.
- Ich möchte die Eingabe (Suchen ("B4")) von der Ziel Tabelle starten nicht von der Suchen&Kopieren Tabelle.

Vielleicht hat jemand eine Idee wie ich den Code ändern muss:

Sub FindAndCopy2c()
 Dim rngSuch As Range, wksDst As Worksheet, wksSrc As Worksheet
 Dim strSuch As String, rngFound As Range
 Dim strFirst As String, FoundAdr As String
 Dim ZeSrc As Integer, ZeDst As Integer, lRow As Long
 Dim i As Integer, ZielOK As Boolean, ZielName As String
 
 ZielName = "Ziel"
 With ThisWorkbook
  For i = 1 To ThisWorkbook.Sheets.Count
   If .Sheets(i).Name = ZielName Then
    ZielOK = True
    Exit For
   End If
   Next i
   If Not ZielOK Then
    .Sheets.Add After:=.Worksheets(Worksheets.Count)
    ActiveSheet.Name = ZielName
   End If
  End With
  
  Set wksSrc = Sheets("Suchen&Kopieren")
  With wksSrc
   lRow = .Cells(Rows.Count, 1).End(xlUp).Row
   Set rngSuch = .Range("B1:B" & lRow)
  End With
  Set wksDst = Sheets(ZielName)
  
  With wksSrc
   If Trim(wksSrc.Range("B4")) = "" Then
    MsgBox "Die Zelle B4 ist leer, darum kann nicht gesucht werden", vbExclamation, "Fehler"
    Exit Sub
   End If
   strSuch = .Range("B4")
   .Range("B4").ClearContents
  End With
  
  With rngSuch
   Set rngFound = .Find(what:=strSuch, LookAt:=xlWhole)
   If Not rngFound Is Nothing Then
    strFirst = rngFound.Address
    Do
     FoundAdr = rngFound.Address
     ZeSrc = rngFound.Row
     ZeDst = wksDst.Cells(Rows.Count, 4).End(xlUp).Row + 1
     Range("A" & ZeSrc & ":C" & ZeSrc).Copy wksDst.Cells(ZeDst, 1)
     Set rngFound = .FindNext(rngFound)
    Loop While Not rngFound Is Nothing And rngFound.Address <> strFirst
   Else
    MsgBox "Leider wurde '" & strSuch & "' nicht gefunden!", vbInformation, "Fehleingabe?"
   End If
  End With
 End Sub

 

[ComFreek]

Bitte Code-Tags (siehe meine Signatur) benutzen und Code einrücken. Letzteres habe ich mal auf die Schnelle mit VB Code Indenter erledigt. Das nächste Mal bitte selbst tun.

Ich hoffe, jemand mit VB-Kenntnissen antwortet dir, denn ich hab keine