マクロは、1つのシートから列ごとにコピーして、ヘッダーによってマスターシートに貼り付けて、拡大するデータを維持します。

Question

Excel VBAにはかなり新しく、自分自身のソリューションを探していますジレンマ私は直面している。通常、同僚から生データファイルを受け取り、これらの生データファイルの列数は変わりますが、一貫したヘッダー名を持つことができます。私はワークブックに、新しいデータを追加することで最新の状態にしたいマスタースプレッドシートを持っています（新しいスプレッドシートのデータを次の空の行に追加し続ける）。インポートされたスプレッドシート（​​スプレッドシートAなど）を使用して、列のヘッダー値を確認し、列範囲をコピーします（2行目から列内に挿入する最後まで）。スプレッドシートのマスターヘッダー値を探し、列の範囲を次の空のセルに貼り付けます。この手順は、スプレッドシートAにあるすべての列に適用されます。

ご意見、ご指摘、アドバイスをいただければ幸いです。

例）「マスター」シートと「インポート済み」シートがあります。私は "インポートされた"シートを取って、列1から始まる行1のヘッダーを見たいと思います。そのヘッダーが "マスター"シートに存在する場合は、 "インポートされたシート"から列（マイナスヘッダー）その列の次の空のセルから始まる適切な列ヘッダーの下に「マスター」を追加します。私が最終的にやってみたいのは、 "マスタ"シートに履歴データを保存することですが、 "インポート"シートには移動する列が含まれているため、マスタの次の空のセルから範囲をコピー＆ペーストできませんでした。

Answer 1

テストされていないが、OKコンパイル：

Sub CopyByHeader() 

    Dim shtA As Worksheet, shtB As Worksheet 
    Dim c As Range, f As Range 
    Dim rngCopy As Range, rngCopyTo 

    Set shtA = ActiveSheet ' "incoming data" - could be different workbook 
    Set shtB = ThisWorkbook.Sheets("Master") 

    For Each c In Application.Intersect(shtA.UsedRange, shtA.Rows(1)) 

     'only copy if >1 value in this column (ie. not just the header) 
     If Len(c.Value) > 0 And Application.CountA(c.EntireColumn) > 1 Then 

      Set f = shtB.Rows(1).Find(what:=c.Value, LookIn:=xlValues, _ 
             LookAt:=xlWhole) 
      If Not f Is Nothing Then 

       Set rngCopy = shtA.Range(c.Offset(1, 0), _ 
        shtA.Cells(Rows.Count, c.Column).End(xlUp)) 

       Set rngCopyTo = shtB.Cells(Rows.Count, _ 
           f.Column).End(xlUp).Offset(1, 0) 
       'copy values 
       rngCopyTo.Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Value 

      End If 
     End If 
    Next c 

End Sub 

はEDIT：任意のコンテンツを持っている唯一のコピー列に更新され、コピーだけに、私が仕事をする上での取得、および同じ結果を必要とすることはできません

Answer 2

値元の質問として。何が欠けているかについての考えは？私は私が私のシートに合わせて変更するために必要なすべてを変えたと思った：

Sub CopyByHeader() 


Dim shtMain As Worksheet, shtImport As Worksheet 

Dim c As Range, f As Range 

Dim rngCopy As Range, rngCopyTo 

Set shtImport = ActiveSheet 

' "Import" 

Set shtMain = ThisWorkbook.Sheets("Main") 

For Each c In Application.Intersect(shtImport.UsedRange, shtImport.Rows(1)) 

'only copy if >1 value in this column (ie. not just the header) 

If Len(c.Value) > 0 And Application.CountA(c.EntireColumn) > 1 Then 

Set f = shtMain.Rows(1).Find(what:=c.Value, LookIn:=xlValues, _ 
LookAt:=xlWhole) 

If Not f Is Nothing Then 

Set rngCopy = shtImport.Range(c.Offset(1, 0), _ 
shtImport.Cells(Rows.Count, c.Column).End(xlUp)) 
Set rngCopyTo = shtMain.Cells(Rows.Count, _ 
f.Column).End(xlUp).Offset(1, 0) 

'copy values 

rngCopyTo.Resize(rngCopy.Rows.Count, 1).Value = rngCopy.Value 

End If 

End If 

Next c 

End Sub 

おかげで、 ライアン