Sub СобратьФайлыНаОдинЛист()
    Dim wbW As Workbook, sh As Worksheet
    Workbooks.Add
    Set wbW = ActiveWorkbook
    Set sh = ActiveSheet

    Dim sFolder As String, sFiles As String
    'диалог запроса выбора папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    ' Stop
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)

    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        'Call ГраницыБольшогоДиапазона(sh)
    'открываем книгу
        Workbooks.Open sFolder & sFiles
    'действия с файлом
        'ActiveWorkbook.Sheets(1).UsedRange.Copy sh.cells(lRow + 1, fCol)
    'Закрываем книгу без сохранения изменений
        ActiveWorkbook.Close False    
        sFiles = Dir
    Loop
    MsgBox "Выход"
End Sub