Macro to Copy rows to a new sheet that contain certain text

Hi All,

I have a report containing over 6000 rows of data that I want to summarize on another sheet in the workbook. All of my data is in column A as the report was copied over from another source and running a text to columns on it did not work well. Basically, I want to copy all the rows on sheet "VIC RAW" that contain the words "Lot Total" to sheet "VIC SUMMARY". The rows contain much more than just the words "Lot Total". The total number of rows int he "VIC RAW" sheet can vary, so I would like the range to go to the last used row on the sheet. Each row containing "Lot Total" should be copied to the next blank row on the "VIC SUMMARY" sheet. I have been trying this for days and can't get it. Help is appreciated!!

Thanks!!

Backup your data.
Run: AddLotTotals
If I've misunderstood what you want, reply back and I'll try to fix it.

Sub AddLotTotals()
    Dim rgRaw As Range, nLastSummaryRow As Long, rgCell As Range, sAddress As String
    Dim ws As Worksheet
    
    With Worksheets("VIC RAW")
        Set rgRaw = .Range("A1:A" & Cells(.Rows.Count, "A").End(xlUp).Row)
    End With
    Set ws = Worksheets("VIC SUMMARY")
    With ws
        nLastSummaryRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    
    Set rgCell = rgRaw.Find(What:="Lot Total", _
                           LookIn:=xlValues, _
                           Lookat:=xlPart, _
                           SearchOrder:=xlByRows, _
                           SearchDirection:=xlNext, _
                           MatchCase:=False)
    If Not rgCell Is Nothing Then
        sAddress = rgCell.Address
        Do
            nLastSummaryRow = nLastSummaryRow + 1
            ws.Cells(nLastSummaryRow, "A") = rgRaw.Cells(rgCell.Row, "A")
            Set rgCell = rgRaw.FindNext(rgCell)
        Loop While Not rgCell Is Nothing And sAddress <> rgCell.Address
    End If
End Sub

This works perfectly! thanks so much!!