Нужно объединить 3 файла xls в один.И вставьте значения консолидированного файла в мастер-файл

Question

У меня есть данные в 3 файлах XLS с именами AM, MD, PM.Я хочу объединить все 3 файла XLS в 1 файл XLS, используя VBA.

Также данные, которые есть в этих 3 файлах XLS, я хочу только из определенного столбца строки и строки.Скажем, например, от ячейки A41 до A53, от B41 до B53 до U41 до U53 для всех 3 файлов.В результате я хочу, чтобы xls-файл был консолидированно создан только с теми строками и столбцами, которые мне нужно оставить оставшимися.

После создания этого консолидированного файла я хочу импортировать эти значения в XLS-файл основного шаблона.Поэтому, когда я нажимаю кнопку в главном файле шаблона Excel, он должен объединить 3 файла XLS, создать один файл и отразить его значения в главном файле шаблона XLS. [Введите описание изображения здесь] [1]

[введите изображениеописание здесь] [2]

введите описание изображения здесь

Sub loopthroughDirectory()

Dim Myfile As String

Dim erow

Myfile = Dir("Path")


Do While Len(Myfile) > 0

If Myfile = "zmaster.xlsm" Then

Exit Sub
End If


Workbooks.Open (Myfile)
Range("A41:T53").Copy
ActiveWorkbook.Close


erow = car.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

ActiveSheet.Paste Destination:=Worksheets("Car").Range(Cells(erow, 1), 

Cells(erow, 20))


Myfile = Dir

Loop

End Sub

Но это не работает.Он может открывать файлы, но значения не вставляются в консолидированный файл, который я пытаюсь сгенерировать.Предложения будут оценены.

Answer 1

Я предпочитаю выбирать файлы с помощью диалогового окна «Файл» для обеспечения согласованности и достоверности результатов, но за несколько секунд многократный выбор файла. Рабочий код для вашей ситуации будет выглядеть примерно так:

Option Explicit

Sub Consolidation()

Dim CurrentBook As Workbook
Dim WS As Worksheet
Dim wsn As Worksheet
Set WS = ThisWorkbook.Sheets("car")
Dim IndvFiles As FileDialog
Dim FileIdx As Long
Dim i As Integer, x As Integer

Set IndvFiles = Application.FileDialog(msoFileDialogOpen)'Select your AM,Md, Pm files here
With IndvFiles
    .AllowMultiSelect = True
    .Title = "Multi-select target data files:"
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xls files", "*.xls"
    .Show
End With

Application.DisplayAlerts = False
Application.ScreenUpdating = False

For FileIdx = 1 To IndvFiles.SelectedItems.Count
    Set CurrentBook = Workbooks.Open(IndvFiles.SelectedItems(FileIdx))
   Set wsn = CurrentBook.Sheets(1)
        Dim LRow1 As Long
        LRow1 = WS.Range("A" & WS.Rows.Count).End(xlUp).Row
        Dim LRow2 As Long
        LRow2 = CurrentBook.ActiveSheet.Range("A" & CurrentBook.ActiveSheet.Rows.Count).End(xlUp).Row

        Dim ImportRange As Range
        Set ImportRange = CurrentBook.ActiveSheet.Range("A41:T53")' As per yr code adjust if required
        ImportRange.Copy
        WS.Range("A" & LRow1 + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    'Next
    CurrentBook.Close False
Next FileIdx

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub