VBA - 複数のワークブックの値を複数のシートを含むマスターファイルにコピー/ペースト/統合する方法

Question

Good Day！私はこれらの複数のワークブックを自分のデータソース、つまり "Data1、Data2 and Data3"としています。以下の画像を参照してください。 私の問題は、これらの3つのブックから複数のシートを持つ「MasterFile.xlsx」という名前の別のブックにデータを取得したいということです。 "Data1"はMasterFile Sheet1に、 "Data2"はMasterFile Sheet2に、 "Data3"はMasterFile Sheet3に移動します。私のマスターファイルのすべてのシートがすでにdata..Please用のテンプレートが私のマスターファイル

については、以下の画像を参照しているこれは、私がこれまで行ってきたものです。 1つのワークブックにデータを1つのシートにまとめることしかできません。

Public Sub Data() 
Dim wbk As Workbook 
Dim Filename As String 
Dim Path As String 
Dim sht, msht As Worksheet 
Dim lRowFile, lRowMaster As Long 
Dim FirstDataSet As Integer 

On Error Resume Next 

Path = "C:\Users\source\" 

Filename = "Data1.xlsx" 

Set wbk = Workbooks.Open(Path & Filename) 

Set sht = Workbooks(Filename).Worksheets(1) 
Set msht = ThisWorkbook.Worksheets(1) 

lrF = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row 
lRM = msht.Cells(Rows.Count, 2).End(xlUp).Row 
FirstDataSet = 2 

For i = FirstDataSet To lrF 
    lRM = msht.Cells(Rows.Count, 2).End(xlUp).Row 
    msht.Range("B" & lRM + 1).Value = sht.Range("A" & i).Value 
    msht.Range("C" & lRM + 1).Value = sht.Range("E" & i).Value 
    msht.Range("E" & lRM + 1).Value = sht.Range("B" & i).Value 
    msht.Range("F" & lRM + 1).Value = sht.Range("D" & i).Value 
    msht.Range("I" & lRM + 1).Value = sht.Range("F" & i).Value 
    msht.Range("J" & lRM + 1).Value = sht.Range("G" & i).Value 
    msht.Range("K" & lRM + 1).Value = sht.Range("H" & i).Value 
    msht.Range("L" & lRM + 1).Value = sht.Range("I" & i).Value 
    msht.Range("M" & lRM + 1).Value = sht.Range("J" & i).Value 
    msht.Range("N" & lRM + 1).Value = sht.Range("K" & i).Value 
Next 
wbk.Close True 

End Sub 

はありがとう、私を助けてください！

Answer 1

役に立つかもしれません後

Public Sub Data() 
    Application.ScreenUpdating = False 
    Dim wbk As Workbook 
    Dim Filename As String 
    Dim Path As String 
    Dim sht, msht As Worksheet 
    Dim shtLR, mshtLR As Long 
    Dim FirstDataSet As Integer 

    On Error Resume Next 

    Path = "C:\Users\source\" 
    FirstDataSet = 2 

    '------------------------------For Sheet1------------------------------ 
    Filename = "Data1.xlsx" 
    Set wbk = Workbooks.Open(Path & Filename) 
    Set sht = Workbooks(Filename).Worksheets(1) 

    Set msht = ThisWorkbook.Worksheets(1) 

    shtLR = sht.Cells(Rows.Count, "C").End(xlUp).Row 
    mshtLR = msht.Cells(Rows.Count, "B").End(xlUp).Row 

    msht.Range("B" & mshtLR + 1 & ":B" & mshtLR - 1 + shtLR).Value = sht.Range("C" & FirstDataSet & ":C" & shtLR).Value 
    msht.Range("C" & mshtLR + 1 & ":C" & mshtLR - 1 + shtLR).Value = sht.Range("E" & FirstDataSet & ":E" & shtLR).Value 
    msht.Range("E" & mshtLR + 1 & ":E" & mshtLR - 1 + shtLR).Value = sht.Range("G" & FirstDataSet & ":G" & shtLR).Value 
    msht.Range("F" & mshtLR + 1 & ":F" & mshtLR - 1 + shtLR).Value = sht.Range("D" & FirstDataSet & ":D" & shtLR).Value 
    msht.Range("I" & mshtLR + 1 & ":I" & mshtLR - 1 + shtLR).Value = sht.Range("F" & FirstDataSet & ":F" & shtLR).Value 
    msht.Range("J" & mshtLR + 1 & ":J" & mshtLR - 1 + shtLR).Value = sht.Range("H" & FirstDataSet & ":H" & shtLR).Value 
    msht.Range("K" & mshtLR + 1 & ":K" & mshtLR - 1 + shtLR).Value = sht.Range("I" & FirstDataSet & ":I" & shtLR).Value 
    msht.Range("L" & mshtLR + 1 & ":L" & mshtLR - 1 + shtLR).Value = sht.Range("J" & FirstDataSet & ":J" & shtLR).Value 
    msht.Range("M" & mshtLR + 1 & ":M" & mshtLR - 1 + shtLR).Value = sht.Range("K" & FirstDataSet & ":K" & shtLR).Value 
    msht.Range("N" & mshtLR + 1 & ":N" & mshtLR - 1 + shtLR).Value = sht.Range("L" & FirstDataSet & ":L" & shtLR).Value 

    wbk.Close True 


    '------------------------------For Sheet2------------------------------ 
    Filename = "Data2.xlsx" 
    Set wbk = Workbooks.Open(Path & Filename) 
    Set sht = Workbooks(Filename).Worksheets(1) 

    Set msht = ThisWorkbook.Worksheets(2) 

    shtLR = sht.Cells(Rows.Count, "A").End(xlUp).Row 
    mshtLR = msht.Cells(Rows.Count, "B").End(xlUp).Row 

    msht.Range("B" & mshtLR + 1 & ":B" & mshtLR - 1 + shtLR).Value = sht.Range("B" & FirstDataSet & ":B" & shtLR).Value 
    msht.Range("C" & mshtLR + 1 & ":C" & mshtLR - 1 + shtLR).Value = sht.Range("D" & FirstDataSet & ":D" & shtLR).Value 
    msht.Range("D" & mshtLR + 1 & ":D" & mshtLR - 1 + shtLR).Value = sht.Range("E" & FirstDataSet & ":E" & shtLR).Value 
    msht.Range("F" & mshtLR + 1 & ":F" & mshtLR - 1 + shtLR).Value = sht.Range("G" & FirstDataSet & ":G" & shtLR).Value 
    msht.Range("G" & mshtLR + 1 & ":G" & mshtLR - 1 + shtLR).Value = sht.Range("H" & FirstDataSet & ":H" & shtLR).Value 
    msht.Range("J" & mshtLR + 1 & ":J" & mshtLR - 1 + shtLR).Value = sht.Range("J" & FirstDataSet & ":J" & shtLR).Value 
    msht.Range("K" & mshtLR + 1 & ":K" & mshtLR - 1 + shtLR).Value = sht.Range("K" & FirstDataSet & ":K" & shtLR).Value 
    msht.Range("L" & mshtLR + 1 & ":L" & mshtLR - 1 + shtLR).Value = sht.Range("L" & FirstDataSet & ":L" & shtLR).Value 

    wbk.Close True 


    '------------------------------For Sheet3------------------------------ 
    Filename = "Data3.xlsx" 
    Set wbk = Workbooks.Open(Path & Filename) 
    Set sht = Workbooks(Filename).Worksheets(1) 

    Set msht = ThisWorkbook.Worksheets(3) 

    shtLR = sht.Cells(Rows.Count, "C").End(xlUp).Row 
    mshtLR = msht.Cells(Rows.Count, "B").End(xlUp).Row 

    msht.Range("B" & mshtLR + 1 & ":B" & mshtLR - 1 + shtLR).Value = sht.Range("D" & FirstDataSet & ":D" & shtLR).Value 
    msht.Range("C" & mshtLR + 1 & ":C" & mshtLR - 1 + shtLR).Value = sht.Range("F" & FirstDataSet & ":F" & shtLR).Value 
    msht.Range("E" & mshtLR + 1 & ":E" & mshtLR - 1 + shtLR).Value = sht.Range("G" & FirstDataSet & ":G" & shtLR).Value 
    msht.Range("F" & mshtLR + 1 & ":F" & mshtLR - 1 + shtLR).Value = sht.Range("I" & FirstDataSet & ":I" & shtLR).Value 
    msht.Range("I" & mshtLR + 1 & ":I" & mshtLR - 1 + shtLR).Value = sht.Range("J" & FirstDataSet & ":J" & shtLR).Value 
    msht.Range("J" & mshtLR + 1 & ":J" & mshtLR - 1 + shtLR).Value = sht.Range("K" & FirstDataSet & ":K" & shtLR).Value 
    msht.Range("K" & mshtLR + 1 & ":K" & mshtLR - 1 + shtLR).Value = sht.Range("L" & FirstDataSet & ":L" & shtLR).Value 

    wbk.Close True 

    Application.ScreenUpdating = True 
End Sub 

EDIT 1：すべてのデータファイルが保存されている

1.：________________________________________________________________________

次のコードを円滑に実行するための前提条件は、名前がData1.xls,Data2.xls,Data3.xls,Data4.xlsなど。

2.Column Cのデータシートに値があります。これは、シート内のレコード数をカウントするために使用される列です。

Column Bは、シート内のレコード数のカウントに使用される列です。

4.Master fileの枚数は、データファイルの数と同じです。次のように、ファイル名の別の配列を作ることができ________________________________________________________________________

：これはm1Array()

Option Explicit 

Public Sub Data() 
    Application.ScreenUpdating = False 
    Dim wbk As Workbook 
    Dim Filename As String 
    Dim Path As String 
    Dim sht, msht As Worksheet 
    Dim shtLR, mshtLR As Long 
    Dim FirstDataSet, i, j As Integer 
    Dim m1Array(), m2Array() As Variant 

    On Error Resume Next 

    'm1Array is the array where column names of the data files e.g. data1.xls, data2.xls, etc. are stored 
    m1Array = Array(Array("B", "C", "E", "F", "I", "J", "K", "L", "M", "N"), _ 
        Array("B", "C", "D", "F", "G", "J", "K", "L"), _ 
        Array("B", "C", "E", "F", "I", "J", "K")) 

    'm2Array is the array where column names of the master file sheet are stored 
    m2Array = Array(Array("C", "E", "G", "D", "F", "H", "I", "J", "K", "L"), _ 
        Array("B", "D", "E", "G", "H", "J", "K", "L"), _ 
        Array("D", "F", "G", "I", "J", "K", "L")) 

    Path = "C:\Users\source\" 
    FirstDataSet = 2 

    'looping through all the data files 
    For j = LBound(m1Array) To UBound(m1Array) 
     Filename = "Data" & j + 1 & ".xlsx" 
     Set wbk = Workbooks.Open(Path & Filename) 
     Set sht = Workbooks(Filename).Worksheets(1) 

     Set msht = ThisWorkbook.Worksheets(j + 1) 

     shtLR = sht.Cells(Rows.Count, "C").End(xlUp).Row 
     mshtLR = msht.Cells(Rows.Count, "B").End(xlUp).Row 

     'looping through each columns of the data sheet and corresponding master file sheet 
     For i = LBound(m1Array(j)) To UBound(m1Array(j)) 
      msht.Range(m1Array(j)(i) & mshtLR + 1 & ":" & m1Array(j)(i) & mshtLR - 1 + shtLR).Value = sht.Range(m2Array(j)(i) & FirstDataSet & ":" & m2Array(j)(i) & shtLR).Value 
     Next i 

     wbk.Close True 
    Next j 
    Application.ScreenUpdating = True 
End Sub 

EDIT 2の長さを用いて決定されます

Dim fileArray() As Variant 
fileArray = Array("Schools.xlsx", "Students.xlsx", "Managers.xlsx") 

次にライン

の下に置き換えます

Filename = "Data" & j + 1 & ".xlsx" 

〜

Filename = fileArray(j)