Sub Консолидация()

    Dim strPath As String, strFileName As String
    Dim shSrc As Worksheet, shAct As Worksheet
    Dim lr As Long
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = 0 Then
            Exit Sub
        End If
        strPath = .SelectedItems(1)
    End With
    
    Application.ScreenUpdating = False
    Set shAct = ActiveSheet
    lr = shAct.Cells(shAct.Rows.Count, "C").End(xlUp).Row
    strFileName = Dir(strPath & "\*.xlsx")
    Do While strFileName <> ""
        Set shSrc = Workbooks.Open(Filename:=strPath & "\" & strFileName, ReadOnly:=True).Worksheets(1)
        shSrc.Range("H2:N" & lr).Copy
        shAct.Range("H2").PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True
        shSrc.Parent.Close SaveChanges:=False
        strFileName = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Готово!", vbInformation

End Sub