Verbesserung Suchen und Kopieren
18.03.2020 19:02:48
Metz
da ich meinen Thread von letzter Woche nicht finde, eröffne ich ein neues.
Ich würde euch gern bitten den bereitgestellten Code aufzuwerten/anzupassen.
Sub Suche_Und_Kopiere()
Dim rngC As Range, strAdresse As String
Application.ScreenUpdating = False
With Worksheets("Tabelle1").Columns("A")
Set rngC = .Find("Beispiel1")
If Not rngC Is Nothing Then
strAdresse = rngC.Address
Do
rngC.Offset(, -0).Resize(, 8).Copy
With Worksheets("Tabelle2")
.Cells(.Rows.Count, 2).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
End With
Set rngC = .FindNext(rngC)
Loop While Not rngC.Address = strAdresse
End If
End With
Application.CutCopyMode = False
End Sub
Hier meine Bitte:
Gerne würde ich die Eingabe nicht mehr im Code, sondern in einer Zelle eingeben wollen (zum Beispiel: Gesucht soll nach den Wert in "C5") und auch soll nicht eine spezielle Spalte durchsucht werden, sondern alle verfügbaren Spalten (Beispiel: A-D)
Ich bedanke mich im Voraus
Metz