Sub CombineWorkbooks()
Dim FilesToOpen
Dim x As Integer
On Error GoTo ErrHandler
Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xls), *.xls", _
MultiSelect:=True, Title:="Files to Merge")
If TypeName(FilesToOpen) = "Boolean" Then
MsgBox "Не выбрано ни одного файла!"
GoTo ExitHandler
End If
x = 1
While x <= UBound(FilesToOpen)
Workbooks.Open Filename:=FilesToOpen(x)
Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
x = x + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
ErrHandler:
MsgBox Err.Description
Resume ExitHandler
End Sub

Option Explicit
Public timecreate As Variant
Public distance As String
Public kolfile As Integer

Sub Getfiles()
Dim fName As String, NewName As String, msg As Integer
kolfile = 0
'distance = "\\ts\DATA\Exchange\gaz\"
distance = "e:\zakaz\"
fName = Dir(distance & "*.*")
Do While fName <> ""
     timecreate = FileDateTime(distance & fName)
     Workbooks.Open distance & fName
         data fName
     Workbooks(fName).Close True
     NewName = Replace(Replace(timecreate, ".", ""), ":", "") & fName
     Name distance & fName As distance & "/reports/" & NewName
     kolfile = kolfile + 1
     fName = Dir
Loop
msg = MsgBox("Обработано файлов: " & kolfile, 0, "Обработка завершена")
End Sub

Sub data(file_ As String)
Dim col As Integer, schet As Integer
With Workbooks("full.xlsm").Sheets(1)
     col = .Cells(1, Columns.Count).End(xlToLeft).Column
     schet = .Cells(Rows.Count, 1).End(xlUp).Row
     .Range("a2:a" & schet).Offset(, col).Value = Workbooks(file_).Sheets(1).Range("b3:b" & schet + 1).Value
     .Range("a1").Offset(, col).Value = Workbooks(file_).Sheets(1).Range("a1").Value
End With
End Sub