Come avrei messo il processo VBA in un ciclo?

Question

Modifica: L'ho capito, grazie a un post utile.Il mio codice finale è qui sotto.

Sto usando Excel, e ho questo script VBA che cerca una stringa, copialo, poi la incolla due celle.Quello che mi piacerebbe fare è avere il processo ripetere per l'intero foglio finché non raggiunge l'ultima occorrenza.

Qualcuno può aiutarmi a metterlo in un ciclo o qualcosa di simile?

Sub PasteOffset()
    Dim rng1 As Range
    Dim strSearch As String
    strSearch = "Transaction Number*"

    Set rng1 = Range("A:A").Find(strSearch, , xlValues, xlWhole)

    If Not rng1 Is Nothing Then
    rng1.Select
    rng1.Copy
    rng1.Offset(2, 0).PasteSpecial

    Else
    MsgBox "all done"

    End If
    End Sub

.

Answer 1

Questo funziona:

Sub PasteOffset()

Dim rng1 As Range
Dim strSearch As String
strSearch = "Transaction Number*"

For CellNumber = 355 To 1 Step -1
Set rng1 = Range("A" & CellNumber)

If rng1.Value Like strSearch Then
    rng1.Select
    rng1.Copy
    rng1.Offset(2, 0).PasteSpecial
End If

Next CellNumber
End Sub

.

Answer 2

qualcosa del genere?:

Sub PasteOffset()

Dim rng1 As Range
Dim strSearch As String
strSearch = "Transaction Number*"

For CellNumber = 300 to 1 Step -1 'Write the end number here (instead of 300)
    Set rng1 = Range("A" & CellNumber )

    If rng1.Value = strSearch Then
        rng1.Select
        rng1.Copy
        rng1.Offset(2, 0).PasteSpecial
    End If

Next CellNumber 
End Sub

.

Answer 3

Dare questo un tentativo:

Sub tgr()

    Dim rngFound As Range
    Dim rngAll As Range
    Dim AllCell As Range
    Dim strSearch As String
    Dim strFirst As String

    strSearch = "Transaction Number*"

    Set rngFound = Columns("A").Find(strSearch, Cells(Rows.Count, "A"), xlValues, xlWhole)
    If Not rngFound Is Nothing Then
        Set rngAll = rngFound
        strFirst = rngFound.Address
        Do
            Set rngAll = Union(rngAll, rngFound)
            Set rngFound = Columns("A").Find(strSearch, rngFound, xlValues, xlWhole)
        Loop While rngFound.Address <> strFirst

        For Each AllCell In rngAll.Cells
            AllCell.Copy
            AllCell.Offset(2).PasteSpecial
        Next AllCell
        Application.CutCopyMode = False
    End If

End Sub

.