csv generation help

[Jake975]

I have a macro that creates a csv file of a list of files to be put into pdfsam my issue is i need to adapt it to create another file as well for a different packet. I have attached the module for the code that dose that part of the process.
This time i need it to looks a column "Packet B" and only create a csv file with the numbers from that column.
Also number 3 I need to be a dynamic spot meaning the file could be like the sample name or like "RM###"

Public Sub Temp_clear()
With NightAuditP
.Action.Caption = "Cleaning up Temp files"
End With

Range("A1").EntireRow.Delete
Range("B1").EntireColumn.Delete
End Sub
Public Sub Temp_delete_sheet()
With NightAuditP
.Action.Caption = "Cleaning up Temp files final stages"
End With

Application.DisplayAlerts = False
Sheets("Temp").Delete
Application.DisplayAlerts = True
With NightAuditP
.Action.Caption = "Temp files completed sucessfully"
End With
End Sub
Public Sub ListAllFileedit()

    Dim objFSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim ws As Worksheet
    Dim sPath As String
    Dim lrA As Long
    Dim lrB As Long
With NightAuditP
.Action.Caption = "Creating Temp files"
End With
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set ws = Worksheets.Add
    ActiveSheet.name = "Temp"
    Sheets("Home").Activate
    'Get the folder object associated with the directory
    sPath = ActiveSheet.Range("H1")
    Set objFolder = objFSO.GetFolder(sPath)
    Sheets("Temp").Activate
    ws.Cells(1, 1).Value = "Location"
    ws.Cells(1, 2).Value = "Final Order#"
    'ws.Cells(1, 3).Value = "The file Size is:"

    'Loop through the Files collection
    For Each objFile In objFolder.Files
    'If objFile.Name Like "*.pdf" Then
        lrA = Range("A" & Rows.Count).End(xlUp).Row
        'lrB = Range("B" & Rows.Count).End(xlUp).Row
        ws.Range("A" & lrA + 1).Value = objFile.path
        'ws.Range("B" & lrB + 1).Value = objFile.DateLastModified
        'ws.Range("C" & lrB + 1).Value = objFile.Size
    'End If
    Next
Call TempSort
Call Temp_clear
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Temp").Copy
ActiveWorkbook.SaveAs Filename:=objFolder & "\" & "Temp.csv", FileFormat:=xlCSV
ActiveWorkbook.Close True
Call Temp_delete_sheet

End Sub
Public Sub Save_temp(ByRef argUSF As Object, ByVal argSteps As Integer)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Temp").Copy
ActiveWorkbook.SaveAs Filename:=objFolder & "\" & "Temp.csv", FileFormat:=xlCSV
ActiveWorkbook.Close True
End Sub
Public Sub TempSort()
    Application.ScreenUpdating = False
    Dim rng As Range, WS1 As Worksheet, WS2 As Worksheet, desWS As Worksheet, fnd As Range
    Set WS1 = Sheets("Temp")
    Set WS2 = Sheets("Data List")
With NightAuditP
.Action.Caption = "Sorting Temp files"
End With

     With ActiveWorkbook.Worksheets("Temp").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A1") _
            , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
        .SetRange .Parent.UsedRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    For Each rng In WS2.Range("C2", WS2.Range("C" & WS2.Rows.Count).End(xlUp))
        Set fnd = WS1.Range("A:A").Find(rng, LookIn:=xlValues, lookat:=xlPart)
        If Not fnd Is Nothing Then
            fnd.Offset(, 1) = rng.Offset(, 1)
        End If
    Next rng
    Application.ScreenUpdating = True
    
     With ActiveWorkbook.Worksheets("Temp").Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("B1") _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange .Parent.UsedRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
With NightAuditP
.Action.Caption = "Sorting Temp files completed"
End With

End Sub

Any help would be great thank you for your time

 

[Jake975]

After looking at it more It is this part i know needs adjusted

 For Each rng In WS2.Range("C2", WS2.Range("C" & WS2.Rows.Count).End(xlUp))
        Set fnd = WS1.Range("A:A").Find(rng, LookIn:=xlValues, lookat:=xlPart)
        If Not fnd Is Nothing Then
            fnd.Offset(, 1) = rng.Offset(, 1)
        End If

That is the part that is returning the number for sorting in the desired order

 

[Jake975]

I need to change the rng.offset to 3

 

[Jake975]

Here is the data sheet