Excel VBAデータテーブルと可変列を組み合わせるときに各行にシート名を挿入する

Question

ブック内の複数のシートのデータを集計シートに効率的にコピーするコードがあり、可変数のシートには常に同じデータフォーマット。

入力ファイルの可変数（まったく同じ50％の変数の約50％）が変更され、シート名がサマリーシートにコピーされたデータに追加されるようにコードを拡張する必要があります。次に、固定形式のデータを要約シートにコピーし、シート名とともにその一部を使用して、変数データを参照し、必要な列にコピーします。

現在のコードは以下のとおりです。誰かが列とシート名の追加を手助けできる場合は、私は感謝します。一度に変数データをコピーすると、シート名がわかりやすくなります。

Sub CopyData() 

Application.ScreenUpdating = False 

Dim wsSummary As Worksheet 
Dim LastRow As Long 
Dim LastRow2 As Long 

Set wsSummary = Worksheets("Summary") 

LastRow = wsSummary.Cells(Rows.Count, "A").End(xlUp).Row 

wsSummary.Range("A2:R" & LastRow).Clear 

ShtCount = ActiveWorkbook.Sheets.Count 

For i = 2 To ShtCount 

Worksheets(i).Activate 
LastRow2 = activesheet.Cells(Rows.Count, "A").End(xlUp).Row 

Range("A2:R" & LastRow2).Select 

Selection.Copy 
Sheets("Summary").Activate 

LastRow2 = activesheet.Cells(Rows.Count, "A").End(xlUp).Select 

Do While Not IsEmpty(ActiveCell) 
ActiveCell.Offset(1, 0).Select 
Loop 

ActiveCell.Offset(0, 0).Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
:=False, Transpose:=False 

Application.CutCopyMode = False 

Next i 

End Sub 

おかげ

私はそれが少し良く作るために少しのコードリファクタリングしまし

Answer 1

- しくみはこうだ：

Sub CopyData() 
    Application.ScreenUpdating = False 
    Dim wsSummary As Worksheet 
    Dim LastRowWs As Long 
    Dim LastRowSummary As Long 
    Dim StartRowSummary As Long 
    Set wsSummary = ThisWorkbook.Worksheets("Summary") 
    LastRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row + 1 
    wsSummary.Range("A2:R" & LastRowSummary).Clear 
    For Each ws In ThisWorkbook.Worksheets 
     If ws.Name <> "Summary" Then 
      LastRowWs = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 
      StartRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row + 1 'first empty row 
      ws.Range("A2:R" & LastRowWs).Copy Destination:=wsSummary.Range("A" & StartRowSummary) 
      LastRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row 
      wsSummary.Range("S" & StartRowSummary & ":S" & LastRowSummary) = ws.Name 
     End If 
    Next 
    Application.ScreenUpdating = True 
End Sub 

あなたはそれが最初にかなり似て見ることができるように、私.Select、.Activateなどのコマンドは必要ないのですべて削除し、実行中にスクリプトを遅くする可能性があります。私はまた、ワークシート参照を完全に修飾して、私たちが参照しているワークブックのどの部分が常にわかるようにしています。

LastRowSummaryは最初は最後の行に1を加えた値に設定されています。これは、サマリーシートにヘッダーがある場合は削除しないことを保証するためです。

ループFor Eachループを使用すると、ブック内のすべてのワークシートwsを繰り返し処理できます。

「要約」からデータを抽出したくないので、そのシートのコマンドを実行しないでください。

私たちがいるワークシートからA列の最後の行を探し、要約シートのどこから開始するのかを検出します（後でワークシート名を設定するときに重要です）。

範囲をあるワークシートから別のワークシートにコピーします。これで、コピーしたワークシート名にタグ付けする必要がある行の数がわかります。

我々はwsでワークシートに便利なリファレンスを持っているので、私たちは、開始と終了の行を使用して、ws.Nameに列Sを設定することができ、我々は名前を確認するために早期に検出は、（私が使用したすべての行に設定されていますSはRにコピーするように見えただけなので、Sは次の列で、ワークシート名をどこに移動させるかによって必要に応じて調整します）。

最後に、Application.ScreenUpdatingを元に戻してください。このバージョンでは.Selectまたは.Activateが使用されていないため、シート間をフリックすることはありません。したがって、このプロパティのFalseとTrueの両方の設定を無効にしても問題ありません。

詳しい説明が必要な場合は教えてください。