Como que eu iria colocar VBA processo em um loop?

Question

Editar: Eu descobri, graças a uma útil o post.Meu final de código está abaixo.

Eu estou usando o Excel, e eu tenho esse script VBA que procura uma seqüência de caracteres, copia-o e, em seguida, cola-lo duas células para baixo.O que eu gostaria de fazer é fazer com que o processo se repita para a folha inteira, até atingir a última ocorrência.

Alguém por favor pode me ajudar a colocar isso em um loop ou algo semelhante?

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

Isso funciona:

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

Algo como isso ?:

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

Tentar dar um presente:

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