在找到 function 后创建循环以复制/粘贴 vba 循环

Question

Im trying to create a loop in excel that will find a word and then copy and paste all cells underneath the word into another workbook until a blank cell. Im really new to VBA so please bare with

Sub CopyRows()

Dim Found As Range
Dim NextFreeCell As Range
Dim wkDest As Worksheet

Set wsDest = Workbooks("sample_bills (version 1).xlsx").Worksheets("sample_bills")
Set NextFreeCell = wsDest.Cells(Rows.Count, "C").End(xlUp).Offset(RowOffset:=1)
Set Found = Cells.Find(What:="Paid", LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False)
    If Found Is Nothing Then
    MsgBox "ERROR"
    Else
    i = Found.Row
    j = Found.Column

    End If

    Do
    NextFreeCell = Cells(i, j)
    i = i + 1
    Loop Until IsEmpty(Cells(i, j))

End Sub

This is what ive got so far but will only copy and paste the word paid into the other workbook, and won't continue to do the rest underneath. Any help would be appreciated:)

Answer 1

Update: Managed to solve this by moving the line

Set NextFreeCell = wsDest.Cells(Rows.Count, "C").End(xlUp).Offset(RowOffset:=1)

into the loop