Excel/VBA - さまざまなソース列を使用して、ワークシートの行と列を1つに結合します。

Question

複数のExcelワークシートを1つのマスターワークシートに結合する作業を進めています。次のコードは、すべてのワークシートが同一の列を持っているときのために働く：

Sub CombineData() 
Dim Sht As Worksheet 

'This If will clear Master before combining 
Worksheets("Master").Range("A2:ZZ9000").ClearContents 

For Each Sht In ActiveWorkbook.Worksheets 
    If Sht.Name <> "Master" And Sht.Range("A2").Value <> "" Then 
     Sht.Select 
     LastRow = Range("A9000").End(xlUp).Row 
     Range("A2", Cells(LastRow, "ZZ")).Copy 
     Sheets("Master").Select 
     Range("A9000").End(xlUp).Offset(1, 0).Select 
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
      :=False, Transpose:=False 
    Else 
    End If 
Next Sht 

End Sub 

しかし、私は今、さらに一歩進み、列が記載されているすべてのcolunsを持っているマスターに、ソースワークシートと異なるときのワークシートをマージする必要があります。

This shows the layout of the worksheets I'm testing with, to keep things simple.

私は先の列にすべてのソースをマッピングのいずれかに開いている（例えば

-Source1、マスターに列A、列

-Source2、マスターに列B、列D

-Etc

または単にソースワークシートのすべての列とマスターを再 - I好ましいですn個のソース・ソース・ワークシートが変更されます。

Cheers-

Answer 1

私は、シート1に、マスターから任意の列をマッピングに適したものとするために、あなたのコードにいくつかの変更を行いました。あなたは、この場合には、 ワークシート（ 『マスター』）を組み合わせる前に、マスターがクリアされます文字列 整数 として整数、行数として暗いLASTROWとしてワークシート 薄暗いCOLNAMEとして 薄暗いSHT」）ハードコードにコード サブcombineDataと（内部マッピングを持っています.Range（ "A2：ZZ9000"）。ActiveWorkbook.Worksheets

If Sht.Name = "Sheet2" And Sht.Range("A2").Value <> "" Then 
    Lastrow = Range("A9000").End(xlUp).Row 
    Sheets("Master").Select 
    rowcount = Range("A9000").End(xlUp).Row 
    Sht.Select 
'Map the columns of sheet2 to master 
    Sheets("Master").Range("A" & rowcount & ":A" & rowcount + Lastrow - 2).Value = Sht.Range("A2:A" & Lastrow).Value 
    Sheets("Master").Range("B" & rowcount & ":B" & rowcount + Lastrow - 2).Value = Sht.Range("C2:C" & Lastrow).Value 

    ElseIf Sht.Name = "Sheet3" And Sht.Range("A2").Value <> "" Then 
    Lastrow = Range("A9000").End(xlUp).Row 
    Sheets("Master").Select 
    rowcount = Range("A9000").End(xlUp).Row 
    Sht.Select 
'Map the columns of sheet3 to master 
    Sheets("Master").Range("A" & rowcount & ":A" & rowcount + Lastrow - 2).Value = Sht.Range("A2:A" & Lastrow).Value 
    Sheets("Master").Range("B" & rowcount & ":B" & rowcount + Lastrow - 2).Value = Sht.Range("B2:B" & Lastrow).Value 
    End If 
Next Sht 

End Sub 

の各SHTについてClearContents COLNAME = 1 を**************は*****編集します**************

Sub CombineData() 
Dim Sht As Worksheet 
Dim colname As String 
Dim Lastrow As Integer, rowcount As Integer 
'This If will clear Master before combining 
Worksheets("Master").Range("A2:ZZ9000").ClearContents 
colname = 1 
For Each Sht In ActiveWorkbook.Worksheets 
    If Sht.Name = "Sheet1" And Sht.Range("A2").Value <> "" Then 
Sheets("Sheet1").Select 

Lastrow = Range("A9000").End(xlUp).Row 

    Sheets("Master").Select 
    rowcount = Range("A9000").End(xlUp).Row + 1 
    Sht.Select 
'Map the columns of sheet2 to master 
    Sheets("Master").Range("A" & rowcount & ":A" & rowcount + Lastrow - 2).Value = Sht.Range("A2:A" & Lastrow).Value 
    Sheets("Master").Range("B" & rowcount & ":B" & rowcount + Lastrow - 2).Value = Sht.Range("B2:B" & Lastrow).Value 
    Sheets("Master").Range("C" & rowcount & ":C" & rowcount + Lastrow - 2).Value = Sht.Range("C2:C" & Lastrow).Value 
    Sheets("Master").Range("D" & rowcount & ":D" & rowcount + Lastrow - 2).Value = Sht.Range("D2:D" & Lastrow).Value 

    ElseIf Sht.Name = "Sheet2" And Sht.Range("A2").Value <> "" Then 
Sheets("Sheet2").Select 

    Lastrow = Range("A9000").End(xlUp).Row 
    Sheets("Master").Select 
    rowcount = Range("A9000").End(xlUp).Row + 1 
    Sht.Select 
'Map the columns of sheet3 to master 
    Sheets("Master").Range("A" & rowcount & ":A" & rowcount + Lastrow - 2).Value = Sht.Range("A2:A" & Lastrow).Value 
    Sheets("Master").Range("E" & rowcount & ":E" & rowcount + Lastrow - 2).Value = Sht.Range("B2:B" & Lastrow).Value 
    Sheets("Master").Range("F" & rowcount & ":F" & rowcount + Lastrow - 2).Value = Sht.Range("C2:C" & Lastrow).Value 
    Sheets("Master").Range("G" & rowcount & ":G" & rowcount + Lastrow - 2).Value = Sht.Range("D2:D" & Lastrow).Value 
    Sheets("Master").Range("C" & rowcount & ":C" & rowcount + Lastrow - 2).Value = Sht.Range("E2:E" & Lastrow).Value 

End If 
Next Sht 

End Sub