Somewhat Urgent: Find all matching values and output the corresponding cells

Ladies and Gentlemen,

I have about 5000 lines of database that needs to be separated into about 80 different sheets based on particular values. Below is the code I have attempting to use "Find" in conjunction with a "for loop". However, it appears that I am unable to output other than the first line of match. You will notice that the code is currently outputting row numbers, it will change once I get this issue resolved. Any advise is greatly appreciated.

Sub PopAll()
    
    For i = 2 To 83
        Call New_Sheet_R2
        Sheets(Sheets.Count).Range("H2").Value = "01"
        Sheets(Sheets.Count).Range("K2").Value = vlookupall(Sheets("Class").Cells(i, 1).Value, Sheets("ClassService").Range("A2:B151"), 2)
        Sheets(Sheets.Count).Range("D4").Value = Sheets("Class").Cells(i, 45).Value
        Sheets(Sheets.Count).Range("G4").Value = "ASME B31.3"
        Sheets(Sheets.Count).Range("J4").Value = Sheets("Class").Cells(i, 44).Value
        Sheets(Sheets.Count).Range("U4").Value = Sheets("Class").Cells(i, 4).Value
        Sheets(Sheets.Count).Range("D9").Value = Sheets("Class").Cells(i, 47).Value
        For j = 1 To Sheets("Class").Cells(i, 46).Value
            Dim searchRange As Range, lastCell As Range, cellFound As Range, firstAddress As String
            Dim SearchText As String
            SearchText = Sheets("Class").Cells(i, 1).Value

            'set the search range
            Set searchRange = Sheets("Pipespec").Range("A2:A5305")
            'specify last cell in range
            Set lastCell = searchRange.Cells(searchRange.Cells.Count)
            Set cellFound = searchRange.Find(What:=SearchText, After:=lastCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
            If Not cellFound Is Nothing Then
                Sheets(Sheets.Count).Cells(j + 14, 4).Value = cellFound.Row
                lastCell = cellFound.Address
                Sheets(Sheets.Count).Cells(2, 1).Value = cellFound.Address
            Else
                Sheets(Sheets.Count).Cells(2, 1).Value = "Found Nothing"
            End If
         Next j
    Next i
        
End Sub