Batch create single PDF file from Multiple Word Docs

[winchmatt3]

Currently I have code that creates a single PDF file from multiple Word Docs. I am manually storing the file paths of the files in Cells B2 - B100 like this:

[TABLE="width: 500"]
<tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]"C:\Filepath_Here.doc"[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]"C:\Filepath_Doc2_Here.doc"[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]"C:\Filepath_Doc3_Here.doc"[/TD]
[/TR]
</tbody>[/TABLE]

I need to improve the code so that I can select multiple Word Docs using the File Picker Menu and create a single PDF from that. I am trying to avoid having to stuff all the document filepaths in the worksheet.

Sub MakePDF()    Dim wdDoc As Word.Document
    Dim wdApp As Word.Application
    Dim bNewApp As Boolean
    Dim sh As Worksheet
    Dim r As Integer
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    On Error GoTo 0
    If wdApp Is Nothing Then
        Set wdApp = CreateObject("Word.Application")
        bNewApp = True
    End If
    Set wdDoc = wdApp.Documents.Add
    wdApp.Visible = True


    Set sh = ActiveWorkbook.Worksheets("Sheet1")
    With sh.Sort
        .SortFields.Add Key:=Range("A1"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange ActiveWorkbook.Worksheets("Sheet1").UsedRange
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    r = 1
    Do Until sh.Cells(r, 1).Value = ""
        If Len(wdDoc.Range) > 0 Then
            wdDoc.Bookmarks("\EndOfDoc").Range.InsertBreak wdPageBreak
        End If
        wdDoc.Bookmarks("\EndOfDoc").Range.InsertFile Filename:=sh.Cells(r, 2).Value
        r = r + 1
    Loop
    wdDoc.SaveAs "C:\Users\501290691\Desktop\TEST_MERGE\MyPDF.PDF", wdFormatPDF
    wdDoc.Close wdDoNotSaveChanges
    If bNewApp Then
        wdApp.Quit
    End If
End Sub

Can anyone offer suggestions for me?

Much appreciated!