VBA Loop, Find, Copy, Repeat Loop

Hi everybody, I have a query and hope somebody on here can help me, its regards VBA loops.

I will try to clearly explain what I am trying to do.

Currently,

I import into (sheet1) via some vba a list of all the files found within a folder on my PC.
All filenames include their file extension ( I am only interested in the pdf files not xls ).
I then compare (sheet1) against a master database (sheet2) via formulas to highlight any new files.
I then sort the data in (sheet1) so all the new pdf filenames are at the top or bottom of the list
then select and copy those filenames into a specific column in (sheet2) where they stay.

I have to manually delete the file extension at this point in (sheet2) which I would also like to
automate soon.

Propose Use.

As this is a long winded process, I am trying to automate the whole thing but am finding it a little
hard to resolve.

So to list in order what I am trying to do is this.

1. Import folder list into (sheet1) - this is already working
2. Compare (sheet1) against (sheet2) and list differences - this is already working
3. VBA to loop down (sheet1) column A, all cells with the word "New" copy the result of (sheet1), column B into (sheet2) column C
4. Remove the extension part of the filename which was just copied.
5. Repeat the process until completed.

I have attached some code I have been trying to work on also an example file.

Thanks

Sub test()

    Dim lastRow As Long
    Dim rng As Range
    Dim firstCell As String
    Dim findString As String
    Set ws = Worksheets("Sheet1")
    findString = "New"
    
    lastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

    For i = 1 To lastRow
        
        Set rng = Sheets("Sheet1").Range("A:A").Find(What:=findString, LookIn:=xlValues, lookAt:=xlPart, SearchOrder:=xlByRows)

        If Not rng Is Nothing Then firstCell = rng.Address
        Do While Not rng Is Nothing

            rng.Offset(0, 2) = rng ' This line copies the data into next column
            
            Set rng = Sheets("sheet1").Range("A:A").FindNext(rng)
            If Not rng Is Nothing Then
            If rng.Address = firstCell Then Exit Do
            End If

        Loop
    
    Next

End Sub

Thankyou - I was going around the loop.

Thankyou so much - now appears solved.