Объединить список файлов (в Excel) с заданными c критериями Macro

Question

Объединить список файлов (в Excel) с учетом указанных c критериев:

Пожалуйста, помогите мне. Я застрял, пытаясь объединить некоторые файлы.

Итак, учитывая список путей к файлам в книге Excel. Я пытаюсь объединить их на основе определенных c критериев. В этом случае, когда все файлы, которые начинаются с одинаковых первых трех символов

Столбец C Начиная с C4 и ниже, уже разделяют первые три символа, чтобы определить, какие файлы попадают в один и тот же диапазон.
Тогда в столбце D есть Имя файла, и я хотел бы объединить все те, которые имеют одинаковые значения, в столбце C.

Все файлы (в списке) имеют только один лист на файл и я хотел бы скопировать лист (значения и формат)

Я приложил ниже код, который я сделал, чтобы выбрать папку, а затем импортировать их: (и это только импорт документов Excel в список)

Sub Select_Folder()
    'returns a list of files located in the indicated folder

    Dim directory As String
    Dim firstFile As String
    Dim dataFile As String
    ''Dim bottom As String
    Dim IB As String
    Dim diaFolder As FileDialog

    'checks to see if Filter Mode is on.
    'Prompts the user to turn off filter mode
    'and aborts the function

    If Sheets("Master").FilterMode = True Then
        MsgBox "The Macro was aborted for the following reason:" & vbNewLine & _
        "The Filter on this sheet is still active." & vbNewLine & _
        "Please turn off FilterMode off to continue. (Error: 002)", vbCritical + vbApplicationModal, "Microsoft Excel"
        End
    End If

    'Turn Off Screen Updating and
    'Event Handiling
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With



    Sheets("Master").Range("C4", Range("C4").End(xlDown)).EntireRow.Delete

    'the directory is taken from the inputs on the spreadsheet 

    Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
    With diaFolder
        .AllowMultiSelect = False
        .InitialFileName = "C:\Users\"
        On Error GoTo Err2:
        .Show
        directory = .SelectedItems(1) & "\"
    End With
    Set diaFolder = Nothing

    If Len(Dir(directory, vbDirectory)) = 0 Then
        MsgBox "The Macro was aborted for the following reason:" & vbNewLine & _
        "The directory " & directory & " Does not exist." & vbNewLine & _
        "Please check to make sure that this directory exists. (Error: 005)", vbCritical + vbApplicationModal, "No Directory Exists"
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
        End
    End If

    'sets the first file in the folder
    'if no first file exists, the program ends

    firstFile = Dir(directory)

    If firstFile = "" Then
        MsgBox "The Macro was aborted for the following reason:" & vbNewLine & _
        "There are no files in the directory: " & directory & vbNewLine & _
        "Please check to make sure that there are files in this Directory. (Error: 006)", vbCritical + vbApplicationModal, "No Files Exist"
        With Application
            .ScreenUpdating = True
            .EnableEvents = True
        End With
        End
    End If

    'places the first file in the first row

    Range("B4") = -1
    Range("D4") = firstFile
    Range("C4") = Left(firstFile, Application.WorksheetFunction.Search(" ", firstFile) - 1)
    Range("D2") = directory

    'finds the next files in the folder
    'Looks at the first four characters in the file name
    'if the first four characters returned.

    Do
        dataFile = Dir()
        If dataFile = "" Then
            Exit Do
        ElseIf Left(dataFile, 4) <> "Term" And Left(dataFile, 4) <> "Inac" Then
            Range("D4").Select
            'finds the next blank cell in range "D5"
'            Do Until ActiveCell.Value = ""
            Do Until ActiveCell.Text = ""
                ActiveCell.Offset(1, 0).Activate
            Loop

            ActiveCell.Value = dataFile
            IB = Left(dataFile, Application.WorksheetFunction.Search(" ", dataFile) - 1)
            ActiveCell.Offset(0, -1).Value = IB
            ActiveCell.Offset(0, -2).Value = -1
        End If
    Loop

    'finds the lowest cell in the range to set as the base
    'fills two formulas to find the Name and Type of Report starting at E4 and F4
    'Autofits Columns E and F
Err2:
    Exit Sub
End Sub

Он успешно выведет все имена файлов. В список

Теперь, когда я пытаюсь объединить их. До сих пор я был в состоянии сделать это так, чтобы все они объединялись в Рабочую книгу, которая содержит лист «Мастер».
Не уверен, как заставить его создавать отдельные файлы на основе столбца C.

Sub mergeFiles()
    '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

    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

End Sub

Спасибо! Я ценю это (дайте мне знать, если что-то нужно уточнить)