Первые листы всех XLS файлов в папке перенести в один XLS файл

 Sub FreeBooksOpen()
    Dim MyName As String
    Dim MyPath As String
    Dim sPath As String ' тут вставил
        MyPath = "C:\MyTemp\"
        MyName = Dir(MyPath & "*.xls")
         Do While MyName <> ""
            sPath = MyPath + MyName ' тут вставил
            Excel.Application.Workbooks.Open sPath ' тут изменил
            MyName = Dir
         Loop
End Sub

Sub test() 
  Dim Folder As String 
  Dim wb As String 
  Dim objWb As Workbook 
  Dim workWb As Workbook 
  Dim i As Integer 
  Set workWb = ActiveWorkbook  'Запоминаем активную книгу 
  
  'Показываем диалог выбора папки 
  With Application.FileDialog(msoFileDialogFolderPicker) 
    .Title = "Выберите папку, файлы в которой нужно обработать" 
    .ButtonName = "Выбрать" 
    .AllowMultiSelect = False 
    If .Show Then Folder = .SelectedItems(1) Else Exit Sub 
  End With 
  'Начинаем читать файлы из папки 
  wb = Dir(Folder & Application.PathSeparator & "*.xls") 
  While Len(wb) > 0 
    i = i + 1 
    wb = Folder & Application.PathSeparator & wb 
    Set objWb = Workbooks.Open(wb) 
    workWb.Sheets(1).Cells(i, 1) = objWb.Sheets(1).Cells(1, 1) 
    objWb.Close False 
    wb = Dir 'читаем следующий файл 
  Wend 
End Sub

Sub FreeBooksOpen()
    Dim MyName As String, MyPath As String, sPath As String
    Dim wbTarget As Workbook, wbIstochnik  As Workbook
    Workbooks.Add
    Set wbTarget = ActiveWorkbook
    MyPath = "C:\MyTemp\"
    MyName = Dir(MyPath & "*.xls")
    Do While MyName <> ""
        sPath = MyPath & MyName
        Application.DisplayAlerts = False ' Чтобы открывал с неправильным расширением без вопросов.
        Excel.Application.Workbooks.Open Filename:=sPath, UpdateLinks:=0, ReadOnly:=True
        Application.DisplayAlerts = True
        Set wbIstochnik = ActiveWorkbook
        wbIstochnik.Worksheets(1).Copy Before:=wbTarget.Worksheets(1)
        wbIstochnik.Close savechanges:=False
        MyName = Dir
    Loop
End Sub