---

Sub MergeExcelFiles()
    Dim FolderPath As String
    Dim Filename As String
    Dim Wb As Workbook
    Dim DestSheet As Worksheet
    Dim LastRow As Long
    
    ' Выбор папки с файлами
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Выберите папку с файлами Excel"
        .Show
        If .SelectedItems.Count = 0 Then Exit Sub
        FolderPath = .SelectedItems(1) & "\"
    End With
    
    ' Ускорение работы, отключение лишнего
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set DestSheet = ThisWorkbook.Sheets(1)
    DestSheet.Cells.Clear ' Очищаем лист перед началом
    
    Filename = Dir(FolderPath & "*.xls*") ' Подойдет для .xls и .xlsx
    
    While Filename <> ""
        Set Wb = Workbooks.Open(FolderPath & Filename, ReadOnly:=True)
        
        ' Определяем, есть ли уже данные в нашей книге
        If DestSheet.Range("A1").Value = "" Then
            ' Первый файл копируем полностью (с шапкой)
            Wb.Sheets(1).UsedRange.Copy DestSheet.Range("A1")
        Else
            ' Последующие файлы копируем без шапки (начиная со второй строки)
            LastRow = DestSheet.Cells(DestSheet.Rows.Count, 1).End(xlUp).Row + 1
            With Wb.Sheets(1).UsedRange
                If .Rows.Count > 1 Then
                    .Offset(1, 0).Resize(.Rows.Count - 1).Copy DestSheet.Cells(LastRow, 1)
                End If
            End With
        End If
        
        Wb.Close False ' Закрываем файл без сохранения
        Filename = Dir ' Переход к следующему файлу
    Wend
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Готово! Все файлы объединены."
End Sub