Указание имен файлов для вставленных данных в VBA ... показывает, из каких файлов поступили данные

Question

Я работал над макросом, который будет брать данные из 6 разных файлов, а затем вставлять эти данные в мастер-файл поверх друг друга, чтобы они все были в одном объединенном файле.

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

Например, если в файле A было 1000строк данных, я бы хотел, чтобы столбец A имел значение «A» для каждой строки, связанной с данными из файла A. Если в файле B было 2000 строк данных, то для всех этих строк отображается «b» для всех 2000 строк ипервые 1000 строк будут иметь «a» .....

Моя задача при вводе значений также будет заключаться в том, что это динамический диапазон, поэтому он не будет стандартным числом строк каждый раз.

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

Sub MasterFile_Consolidate()

Dim LastRow As Long



MsgBox "This will take a few moments"

'Open MF
Workbooks.Open Filename:="C:\Users\zk4h90v\Desktop\MasterFile.xlsm", UpdateLinks:=False
    Worksheets("2019").Range("B4:BO65536").Clear

'Admin
Workbooks.Open Filename:="C:\Users\zk4h90v\Desktop\Radley Files\Admin.xlsm", UpdateLinks:=False, ReadOnly:=True, Password:="VWMTA2019!"
    Worksheets("Resource Plan").Activate
    On Error Resume Next
     Worksheets("Resource Plan").ShowAllData
    On Error GoTo 0
    Columns.EntireColumn.Hidden = False
    Rows.EntireRow.Hidden = False


LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Workbooks("Admin.xlsm").Worksheets("Resource Plan").Range("A4:BO" & LastRow).Copy

Workbooks("MasterFile").Activate
Workbooks("MasterFile").Worksheets("2019").Cells(Cells.Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = False

Workbooks("Admin.xlsm").Close SaveChanges:=False

'Blas
Workbooks.Open Filename:="C:\Users\zk4h90v\Desktop\Radley Files\Blas.xlsm", UpdateLinks:=False, ReadOnly:=True, Password:="vklf_blas4"
    Worksheets("Resource Plan").Activate
    On Error Resume Next
     Worksheets("Resource Plan").ShowAllData
    On Error GoTo 0
    Columns.EntireColumn.Hidden = False
    Rows.EntireRow.Hidden = False


LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Workbooks("Blas.xlsm").Worksheets("Resource Plan").Range("A4:BO" & LastRow).Copy



Workbooks("MasterFile").Activate
Workbooks("MasterFile").Worksheets("2019").Cells(Cells.Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = False

Workbooks("Blas.xlsm").Close SaveChanges:=False

'Epstein
Workbooks.Open Filename:="C:\Users\zk4h90v\Desktop\Radley Files\Epstein.xlsm", UpdateLinks:=False, ReadOnly:=True, Password:="ccce2019"
    Worksheets("Resource Plan").Activate
    On Error Resume Next
     Worksheets("Resource Plan").ShowAllData
    On Error GoTo 0
    Columns.EntireColumn.Hidden = False
    Rows.EntireRow.Hidden = False

LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Workbooks("Epstein.xlsm").Worksheets("Resource Plan").Range("A4:BO" & LastRow).Copy


Workbooks("MasterFile").Activate
Workbooks("MasterFile").Worksheets("2019").Cells(Cells.Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = False

Workbooks("Epstein.xlsm").Close SaveChanges:=False

'Deir
Workbooks.Open Filename:="C:\Users\zk4h90v\Desktop\Radley Files\Deir.xlsb", UpdateLinks:=False, ReadOnly:=True, Password:="GFCC2019rft"
    Worksheets("Resource Plan").Activate
    On Error Resume Next
     Worksheets("Resource Plan").ShowAllData
    On Error GoTo 0
    Columns.EntireColumn.Hidden = False
    Rows.EntireRow.Hidden = False

LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Workbooks("Deir.xlsb").Worksheets("Resource Plan").Range("A4:BO" & LastRow).Copy


Workbooks("MasterFile").Activate
Workbooks("MasterFile").Worksheets("2019").Cells(Cells.Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = False

Workbooks("Deir.xlsb").Close SaveChanges:=False

'Palazzotto
Workbooks.Open Filename:="C:\Users\zk4h90v\Desktop\Radley Files\Maria.xlsb", UpdateLinks:=False, ReadOnly:=True, Password:="DATA2019rft"
    Worksheets("Resource Plan").Activate
    On Error Resume Next
     Worksheets("Resource Plan").ShowAllData
    On Error GoTo 0
    Columns.EntireColumn.Hidden = False
    Rows.EntireRow.Hidden = False

LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Workbooks("Maria.xlsb").Worksheets("Resource Plan").Range("A4:BO" & LastRow).Copy


Workbooks("MasterFile").Activate
Workbooks("MasterFile").Worksheets("2019").Cells(Cells.Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = False

Workbooks("Maria.xlsb").Close SaveChanges:=False

'Thummala
Workbooks.Open Filename:="C:\Users\zk4h90v\Desktop\Radley Files\Mahesh.xlsm", UpdateLinks:=False, ReadOnly:=True, Password:="eit19ccor"
    Worksheets("Resource Plan").Activate
    On Error Resume Next
     Worksheets("Resource Plan").ShowAllData
    On Error GoTo 0
    Columns.EntireColumn.Hidden = False
    Rows.EntireRow.Hidden = False

LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Workbooks("Mahesh.xlsm").Worksheets("Resource Plan").Range("A4:BO" & LastRow).Copy


Workbooks("MasterFile").Activate
Workbooks("MasterFile").Worksheets("2019").Cells(Cells.Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = False

Workbooks("Mahesh.xlsm").Close SaveChanges:=False

MsgBox "Done"
End Sub

Если бы я мог включить эту строку кода, чтобы он был применим ккаждая рабочая тетрадь будет огромной помощью!Еще раз спасибо, если я могу уточнить что-то еще, пожалуйста, дайте мне знать, и я немедленно прокомментирую.

Answer 1

Ваш код выиграл бы от извлечения общих частей в отдельную функцию, которая просто извлекает данные из каждого файла.

Скомпилировано, но не проверено:

Sub MasterFile_Consolidate()
    Const ROOT As String = "C:\Users\zk4h90v\Desktop\"
    Dim lastRow As Long, arrData, wbMaster As Workbook
    Dim shtMaster As Worksheet, arrPW, arrFiles, i as long

    MsgBox "This will take a few moments"

    'Open MF
    Set wbMaster = Workbooks.Open(Filename:=ROOT & "MasterFile.xlsm", _
                                  UpdateLinks:=False)

    Set shtMaster = wbMaster.Sheets("2019")
    shtMaster.Range("B4:BO65536").Clear

    arrFiles = Array("Admin.xlsm", "Blas.xlsm")'<< add the rest of your filenames here
    arrPW = Array("password1", "password2")'<< and the passwords here

    For i = lbound(arrFiles) to ubound(arrFiles) 

        arrData = FileData(ROOT & "Radley Files\" & arrFiles(i), arrPW(i)) '<< get the data from this file
        With shtMaster.Cells(Cells.Rows.Count, 2).End(xlUp).Offset(1, 0)
            .Resize(UBound(arrData, 1), UBound(arrData, 2)).Value = arrData '<< add the data
            .Offset(0, -1).Resize(UBound(arrData, 1), 1).Value = arrFiles(i) '<< add the filename
        End With

    Next i

    MsgBox "Done"
End Sub

'edited parameters...
Function FileData(fPath, PW)

    Dim wb As Workbook, sht As Worksheet, lastRow As Long, arrData

    Set wb = Workbooks.Open(Filename:=fPath, UpdateLinks:=False, _
                            Password:=PW)
    Set sht = wb.Worksheets("Resource Plan")
    On Error Resume Next
    sht.ShowAllData
    On Error GoTo 0
    sht.Columns.EntireColumn.Hidden = False
    sht.Rows.EntireRow.Hidden = False

    lastRow = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    arrData = sht.Range(sht.Range("A4"), sht.Range("BO" & lastRow)) '<< get data as array
    wb.Close False

    FileData = arrData

End Function