Comment mettais-je un processus VBA dans une boucle?

Question

edit: Je l'ai compris, grâce à un poste utile.Mon code final est ci-dessous.

J'utilise Excel, et j'ai ce script VBA qui recherche une chaîne, la copie, puis la colle deux cellules.Ce que je voudrais faire, c'est avoir le processus de répétition pour la feuille entière jusqu'à ce qu'il atteigne la dernière occurrence.

Quelqu'un peut-il m'aider s'il vous plaît mettre cela dans une boucle ou quelque chose de similaire?

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

Ceci fonctionne:

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

quelque chose comme ça?:

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

Essayez-le:

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