Sub получить_данные()
Dim fDialog As FileDialog, StrFile As String, titleFlag As Boolean, SUpdating
Dim wb As Workbook, arr(), data, title As Variant, summDict As Object, lr As Long, i As Long, j As Long
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
    .AllowMultiSelect = False
    .title = "Выберите папку для загрузки данных"
    .Show
End With
Set summDict = CreateObject("Scripting.Dictionary"): summDict.Add "Итого", 0
StrFile = Dir(fDialog.SelectedItems(1) & "\*")
titleFlag = False
j = 1
SUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False
Do While Len(StrFile) > 0
    Set wb = Application.Workbooks.Open(fDialog.SelectedItems(1) & "\" & StrFile)
    If titleFlag = False Then title = wb.Worksheets(1).Cells(1, 1).CurrentRegion.Rows(6)
    With wb.Worksheets(1)
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        data = .Range(.Cells(7, 1), .Cells(lr, 3))
    End With
    wb.Close False
    For i = LBound(data, 1) To UBound(data, 1)
        ReDim Preserve arr(1 To 3, 1 To j)
        arr(1, j) = data(i, 1)
        arr(2, j) = data(i, 2)
        arr(3, j) = CDbl(data(i, 3))
        If LCase(arr(1, j)) = LCase("Итого") Then summDict("Итого") = summDict("Итого") + CDbl(arr(3, j))
        j = j + 1
    Next i
    StrFile = Dir
Loop
Application.ScreenUpdating = SUpdating
' выгрузка на лист
With Worksheets("tmp") ' tmp понменять на нужное имя листа (в Вашем примере Вариант 1)
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    If lr > 5 Then .Range(.Cells(6, 1), .Cells(lr, 3)).Clear: lr = 5
    .Cells(lr + 1, 1).Resize(1, UBound(title, 2)) = title
    lr = lr + 2
    For i = LBound(arr, 2) To UBound(arr, 2)
        For j = LBound(arr, 1) To UBound(arr, 1)
            .Cells(lr, j) = arr(j, i)
        Next j
        lr = lr + 1
    Next i
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Cells(lr + 1, 1) = "Итого"
    .Cells(lr + 1, 3) = summDict("Итого")
    Call formatTable(.Name)
End With
End Sub
Private Sub formatTable(shName As String)
Dim rng As Range, sRow As Long, lr  As Long
With Worksheets(shName)
    Set rng = .Cells.Find("Итого")
    .Range(rng, rng.Offset(0, 2)).Interior.ColorIndex = 19
    sRow = rng.Row
    Do
        Set rng = .Cells.FindNext(rng)
        .Range(rng, rng.Offset(0, 2)).Interior.ColorIndex = 19
    Loop While rng.Row <> sRow
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    With .Range(Cells(6, 1), .Cells(lr, 3))
        .Borders.LineStyle = -4142
        .Borders.Color = 8765644
        .Columns(3).NumberFormat = "0.00"
    End With
End With
End Sub

Option Explicit

Sub ProcessFilesInDirectory()
    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim mnth$, tst$, iLastrow&
    
    ' Выбор каталога
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выберите каталог"
        If .Show = -1 Then
            folderPath = .SelectedItems(1) & Application.PathSeparator
        Else
            Exit Sub
        End If
    End With
    
    Set ws = ActiveSheet
    mnth = Trim(Mid(ws.Cells(2, 1), 16))
    
    Application.ScreenUpdating = False
    
    ' Открытие каждого файла в каталоге и выполнение обработки
    fileName = Dir(folderPath & "*.*")
    Do While fileName <> ""
        ' Игнорировать системные файлы, например, "." и ".."
        If Left(fileName, 1) <> "." Then
        iLastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
        Application.StatusBar = "Обработка файла " & fileName
            Set wb = Workbooks.Open(folderPath & fileName)
            tst = Choose(Mid(wb.ActiveSheet.Cells(2, 1), 19, 2), "январь", "февраль", "март", _
            "апрель", "май", "июнь", "июль", "август", _
            "сентябрь", "октябрь", "ноябрь", "декабрь")
            If LCase(mnth$) = tst Then
                wb.ActiveSheet.UsedRange.Offset(6).Copy ws.Cells(iLastrow, 1)
            End If
            wb.Close SaveChanges:=False ' Закрыть файл без сохранения изменений
            Set wb = Nothing
        End If
        
        fileName = Dir ' Переход к следующему файлу
    Loop
    
    iLastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    ws.Rows(iLastrow).Copy ws.Cells(iLastrow + 1, 1)
    ws.Cells(iLastrow + 1, 3).FormulaR1C1 = "=SUM(R[-" & iLastrow - 6 & "]C:R[-1]C)/2"
    
    Application.StatusBar = False
    Application.ScreenUpdating = True
    
    MsgBox "Обработка файлов завершена."
End Sub

Sub получить_данные()
Dim fDialog As FileDialog, StrFile As String, titleFlag As Boolean, SUpdating, tmpSht As Worksheet
Dim wb As Workbook, arr(), data, title As Variant, summDict As Object, lr As Long, i As Long, j As Long
Dim monthCriteria As String
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
    .AllowMultiSelect = False
    .title = "Выберите папку для загрузки данных"
    .Show
End With
Set tmpSht = ThisWorkbook.Worksheets("tmp") ' tmp поменять на нужное имя листа (в Вашем примере Вариант 1)
Set summDict = CreateObject("Scripting.Dictionary"): summDict.Add "Итого", 0
StrFile = Dir(fDialog.SelectedItems(1) & "\*")
titleFlag = False
j = 1
SUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False
Do While Len(StrFile) > 0
    Set wb = Application.Workbooks.Open(fDialog.SelectedItems(1) & "\" & StrFile)
    If titleFlag = False Then title = wb.Worksheets(1).Cells(1, 1).CurrentRegion.Rows(6)
    monthCriteria = Trim(Split(tmpSht.Cells(2, 1), ":")(1))
    With wb.Worksheets(1)
        If Not date_check(.Cells(1, 1), monthCriteria) Then wb.Close False: GoTo label
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        data = .Range(.Cells(7, 1), .Cells(lr, 3))
    End With
    wb.Close False
    For i = LBound(data, 1) To UBound(data, 1)
        ReDim Preserve arr(1 To 3, 1 To j)
        arr(1, j) = data(i, 1)
        arr(2, j) = data(i, 2)
        arr(3, j) = CDbl(data(i, 3))
        If LCase(arr(1, j)) = LCase("Итого") Then summDict("Итого") = summDict("Итого") + CDbl(arr(3, j))
        j = j + 1
    Next i
label:
    StrFile = Dir
Loop
Application.ScreenUpdating = SUpdating
' выгрузка на лист
With tmpSht
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    If lr > 5 Then .Range(.Cells(6, 1), .Cells(lr, 3)).Clear: lr = 5
    .Cells(lr + 1, 1).Resize(1, UBound(title, 2)) = title
    lr = lr + 2
    For i = LBound(arr, 2) To UBound(arr, 2)
        For j = LBound(arr, 1) To UBound(arr, 1)
            .Cells(lr, j) = arr(j, i)
        Next j
        lr = lr + 1
    Next i
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Cells(lr + 1, 1) = "Итого"
    .Cells(lr + 1, 3) = summDict("Итого")
    Call formatTable(.Name)
End With
End Sub
Private Sub formatTable(shName As String)
Dim rng As Range, sRow As Long, lr  As Long
With Worksheets(shName)
    Set rng = .Cells.Find("Итого")
    .Range(rng, rng.Offset(0, 2)).Interior.ColorIndex = 19
    sRow = rng.Row
    Do
        Set rng = .Cells.FindNext(rng)
        .Range(rng, rng.Offset(0, 2)).Interior.ColorIndex = 19
    Loop While rng.Row <> sRow
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    With .Range(Cells(6, 1), .Cells(lr, 3))
        .Borders.LineStyle = -4142
        .Borders.Color = 8765644
        .Columns(3).NumberFormat = "0.00"
    End With
End With
End Sub
Private Function date_check(cell_with_date As String, current_date As String) As Boolean
' функция проверки корректности текущего месяца (записанного в 2 строке первого столбца листа с результатом == cell_with_date) и даты в открываемом файле для загрузки (ячейка А1) == current_date
date_check = False
    With CreateObject("VBscript.Regexp")
        .Global = False: .MultiLine = False: .Pattern = "\d{2}\.\d{2}\.\d{4}"
        If .test(cell_with_date) Then
            If MonthName(Month(.Execute(cell_with_date)(0))) = current_date Then date_check = True: Exit Function
        End If
    End With
End Function