マクロ異なるヘッダのファイルをマージする

Question

私はSheet1とSheet2である2つの異なるシートに取り組んでいます。

今のところ、両方のファイルの列ヘッダーが同じであれば、2枚を組み合わせて管理しています。どのように特定の列を選択する結合されたファイルにマージするか。

2枚のヘッダーをマージするのは難しいですが、2枚のヘッダーのヘッダーが異なるため、同じ種類のデータが含まれています。たとえば、Sheet1はFirst Nameを列ヘッダーとして使用し、Sheet2はNicknameを列ヘッダーとして使用します。

また、列全体をコピーするのは、重大でない列が含まれているためです。

参考のために予期した結果を添付します。

Sub Combine() 
Dim J As Integer 
On Error Resume Next 
Sheets(1).Select 
Worksheets.Add 
Sheets(1).Name = "Combined" 
Sheets(2).Activate 
Range("A1").EntireRow.Select 
Selection.Copy Destination:=Sheets(1).Range("A1") 
For J = 2 To Sheets.Count 
Sheets(J).Activate 
Range("A1").Select 
Selection.CurrentRegion.Select 
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select 
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2) 
Next 
End Sub 

Answer 1

あなたはあなたのデータは、あなたがループ

参照例までは、単純なドゥでシート/列を操作/およびコード

Option Explicit 
Public Sub Example() 
    Dim B As Range, _ 
     C As Range, _ 
     D As Range, _ 
     E As Range, _ 
     F As Range, _ 
     G As Range ' Columns on Sheet1 & Sheet2 

    Dim i%, x% ' Dim as long 

    Dim Sht As Worksheet ' Every Sheet on This Workbook 
    Dim Comb As Worksheet ' Combine Sheet 

    Set Comb = ThisWorkbook.Worksheets("Combine") 

    i = 2 ' Start on row 2 - Sheet1 & Sheet2 
    x = 2 ' Start on row 2 - Combine sheet 

    'Looping through the worksheets in the workbook 
    For Each Sht In ThisWorkbook.Worksheets 
     ' ignore Sheet "Combine" 
     If Sht.Name <> "Combine" Then 
      Debug.Print Sht.Name ' Print on Immediate Window 

      Set B = Sht.Columns(2) 
      Set C = Sht.Columns(3) 
      Set D = Sht.Columns(4) 
      Set E = Sht.Columns(5) 
      Set F = Sht.Columns(6) 

      Do Until IsEmpty(B.Cells(i)) 

       Comb.Columns(1).Cells(x).Value = B.Cells(i).Value 
       Comb.Columns(2).Cells(x).Value = C.Cells(i).Value 
       Comb.Columns(3).Cells(x).Value = D.Cells(i).Value 
       Comb.Columns(4).Cells(x).Value = E.Cells(i).Value 
       Comb.Columns(5).Cells(x).Value = F.Cells(i).Value 

       i = i + 1 
       x = x + 1 
      Loop 

     End If 

     i = 2 ' Reset 1st Loop 

    Next 

    ' Auto-Fit Rows & Columns 
    With Comb.Cells 
     .Rows.AutoFit 
     .Columns.AutoFit 
    End With 
End Sub 

にコメント見ることができるであるかの列が分かっている場合copy/paste - values = values - PasteSpecial methodの例も参照

も参照してください。

Answer 2

私はあなたのコードに追加し、それをコメントしています。私はこれが役立つことを願っています

Sub Combine() 

    Dim J As Integer 
    Dim Rng As Range   ' specify a range to copy 
    Dim R As Long    ' set a variable to calculate a row number 

' On Error Resume Next  ' You want to see the errors and fix them 
           ' therefore don't suppress them 
' Sheets(1).Select   ' you don't need to "select" anything 
' Worksheets.Add    ' instead of adding a sheet I suggest you 
           ' you create a copy of Shhet(1) 

    Sheets("Sheet1").Copy Before:=Sheets(1) 
    ' the new sheet will now be the "ActiveSheet" 
    With ActiveSheet 
     .Name = "Combined" 
     ' delete all the columns you don't want to keep, like:- 
     .Columns("C:K").Delete  ' or .Columns("F").Delete 
     ' if you delete individual columns, delete from right to left (!!) 
    End With 

    ' this part is already done 
' Sheets(2).Activate   ' you don't need to select anything 
' Range("A1").EntireRow.Select 
' Selection.Copy Destination:=Sheets(1).Range("A1") 

    ' Note that sheets are numbered 1 and up. 
    ' Therefore the newly inserted sheet is now # 1 
    ' and the previous #1 is now Sheet(2) 
    For J = 3 To Sheets.Count 
'  Sheets(J).Activate  ' you don't need to activate anything 
'  Range("A1").Select  ' you don't need to select anything either 
'  Selection.CurrentRegion.Select  ' the Selection is already selected 
     With Sheets(J) 
      ' Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select 
      ' It appears that you want to select the range from A2 to lastrow in A -1 
      R = .Cells(.Rows.Count, "A").End(xlUp).Row 
      Set Rng = .Range(.Cells(2, "A"), .Cells(R - 1, "A")) 
      ' avoid using the Selection object. Use Range object instead:- 
      ' Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2) 
      Rng.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2) 
     End With 
    Next J 
End Sub 

複数の列で構成される範囲を1回の操作でコピーできます。コピーする範囲の定義を変更するだけです。これにより列A：Eがコピーされます。

Set Rng = .Range(.Cells(2, "A"), .Cells(R - 1, "E"))

それ以外の変更は必要ありません。