Sub Макрос2()
'
' Макрос2 Макрос
'
' Сочетание клавиш: Ctrl+ц
'
    Sheets("производство").Select
    Range("B2:I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("ВЕСЬ ПЕРСОНАЛ").Select
    Range("B2").Select
    ActiveSheet.Paste
    
    Sheets("склад").Select
    Range("B2:I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ВЕСЬ ПЕРСОНАЛ").Select
    Selection.End(xlDown).Select
    Range("B96").Select
    ActiveSheet.Paste
    Sheets("учебный центр").Select
    Range("B2:I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ВЕСЬ ПЕРСОНАЛ").Select
    Selection.End(xlDown).Select
    Range("B99").Select
    ActiveSheet.Paste
    Sheets("АХО").Select
    Range("B2:I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ВЕСЬ ПЕРСОНАЛ").Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Range("B100").Select
    ActiveSheet.Paste
    Sheets("бухгалтерия").Select
    Range("B2:I2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("ВЕСЬ ПЕРСОНАЛ").Select
    Selection.End(xlDown).Select
    Range("B110").Select
    ActiveSheet.Paste


End Sub

Sub simpleXlsMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
 

Set dirObj = mergeObj.Getfolder("C:\Users\HP\Downloads\сборка\")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
 
'вместо "A2" указывается адрес ячейки в каждом файле, с которой начинать сборку
'например, "B3:IV" объединит все данные из файлов, начиная с ячейки B3
Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
 
'Здесь столбец не менять
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False

everyObj.Name.Copy
Range("A65536").End(xlUp).Offset(1, -5).PasteSpecial

bookList.Close
Next
End Sub

Sub main()
    Set wa = CreateObject("Word.Application")
    wa.Visible = True: Set wd = wa.Documents.Open "C:\Users\HP\Downloads\РАСЧЕТ.docx"
    [b6:c51].Copy
    wd.Range.PasteExcelTable False, False, False
    Application.CutCopyMode = False
End Sub