Option Explicit

Sub a_soberi_dannyye()
    Const shBD = "Baza"
    Const dpznbgBD = "A1"       ' => nachalo diapazona lista "Baza"
    Const dpznbgistnk = "A1"    ' => nachalo diapazona istochnikov
    ' 'clsmax' => kolichestvo stolbtsov dlya kopirovaniya iz diapazona istochnikov
    Const clsmax = 28           ' => simvolicheskoye "A:AB"
    Const ffltr = "All files (*.*), *.*,Excel files (*.xls**), *.xls**"
    
    Dim fto: fto = Application.GetOpenFilename(ffltr, 2, "Files to Merge", , True)
    If TypeName(fto) = "Boolean" Then
        MsgBox "?! @$&#^*&^%*#%&^#%*&#%&_(*(*#%&#%& ?! .... !!!!!!!!" ' ... :)
        Exit Sub
    End If
    
    Dim thswb$, fle, tbl, exl As Object, thswbsh As Object
    
    With ThisWorkbook
        thswb = .Name
        Set thswbsh = .Sheets(shBD)
    End With
    
    Application.ScreenUpdating = False
    
    For Each fle In fto
        If Right(fle, Len(fle) - InStrRev(fle, "\", -1, 1)) <> thswb Then
            Set exl = GetObject(fle)
            With exl
                'Windows(.Name).Visible = True 'Tol'ko dlya testirovaniya
                With .Worksheets(1).Range(dpznbgistnk).CurrentRegion.Columns
                    tbl = .Offset(1, 0).Resize(.Rows.Count - 1, clsmax).Value
                End With
                'Windows(.Name).Visible = False 'Tol'ko dlya testirovaniya
                .Close False
            End With
            Set exl = Nothing
            With thswbsh.Range(dpznbgBD).CurrentRegion.Columns(1)
                .Offset(.Rows.Count, 0).Resize(UBound(tbl, 1), clsmax).Value = tbl: tbl = Empty
            End With
        End If
    Next
    
    thswbsh.Range(dpznbgBD).CurrentRegion.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub