Hallo an das Forum....
Ich benötige mal Eure hilfe....
hab versucht eine Schleife einzubauen die einmal für den Zellenbereich (F2:F60) durchlaufen soll,
aber jedesmal beim Start, rattert der Code solange durch bis ich mit Esc Taste abbreche.
Als Laie ist das nicht ganz einfach wie für Profis wie Euch....

Sub FindString()
Application.DisplayAlerts = False
Dim c As Range
Dim a As String

Range("F3").Activate
With Tabelle1.Range("F2:F60")
Set c = .Find("1", LookIn:=xlValues)
If Not c Is Nothing Then
a = c.Address
Do
c.Activate
ActiveCell.Offset(0, -5).Copy
Range("H65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Set c = .FindNext(c)
Loop While Not c Is Nothing
End If
End With
Application.DisplayAlerts = True
End Sub