Изменить VBA из диалогового окна выбора в активную папку

Question

Мы используем код ниже, чтобы взять все выбранные рабочие книги. И объединяя их в виде листов в одной книге, затем объединяя все листы в один список.

Работает нормально.

Но я хотел бы, чтобы он занял все файлы в активной папке, заканчивающиеся на " packaginglist.xlsx" ( для подстановочного знака). Без диалогового окна для экономии времени и потенциальных ошибок.

Sub Konsolider_pakkeliste()
    'Merges all files in a folder to a main file.

    'Define variables:
    Dim numberOfFilesChosen, i As Integer
    Dim tempFileDialog As FileDialog
    Dim mainWorkbook, sourceWorkbook As Workbook
    Dim tempWorkSheet As Worksheet
    Dim xTCount As Variant
    Dim xWs As Worksheet
    On Error Resume Next


    Workbooks.Add
    ChDir "C:\XML_Pakkelister\" & Range("C6")
    ActiveWorkbook.SaveAs FileName:= _
        "C:\XML_Pakkelister\" & Range("C6") & "\" & Range("C4") & " Consolidated packaginglist.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False

    '*******************************************************************************************
    Set mainWorkbook = Application.ActiveWorkbook
    Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)

    'Allow the user to select multiple workbooks
    tempFileDialog.AllowMultiSelect = True

    numberOfFilesChosen = tempFileDialog.Show

    'Loop through all selected workbooks
    For i = 1 To tempFileDialog.SelectedItems.count

        'Open each workbook
        Workbooks.Open tempFileDialog.SelectedItems(i)

        Set sourceWorkbook = ActiveWorkbook

        'Copy each worksheet to the end of the main workbook
        For Each tempWorkSheet In sourceWorkbook.Worksheets
            tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.count)
        Next tempWorkSheet

        'Close the source workbook
        sourceWorkbook.Close
    Next i
    '*******************************************************************************************
    'UpdateByKutools20151029
    'Combine the sheets

LInput:
    xTCount = 1
    Set xWs = ActiveWorkbook.Worksheets.Add(Sheets(1))
    xWs.Name = "Combined"
    Worksheets(2).Range("A17").EntireRow.Copy Destination:=xWs.Range("A17")
    For i = 2 To Worksheets.count
        Worksheets(i).Range("A17").CurrentRegion.Offset(CInt(xTCount), 0).Copy _
               Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.count).Row, 1)

    Next

End Sub