複数のシートにデータを転記するVBAコードの改善方法

Excel VBAを使って、複数のシートにデータを転記する方法についての質問です。特に、シート1のデータをシート2やシート3に転記したい場合の解決方法について詳しく解説します。

問題のコード：複数シートに転記したい

質問者の提供されたコードは、シート1のデータを「転記」というシートにコピーするものです。しかし、複数シートにデータを転記する場合、どのように修正すればよいのでしょうか？

Sub 転記()
Dim sh As Worksheet
Dim r1 As Long, r2 As Long
Application.ScreenUpdating = False
Set sh = Worksheets("シート1")
r2 = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1
With Worksheets("転記")
.Range("A16:BM" & .Cells(Rows.Count, "A").End(xlUp).Row).Copy Destination:=sh.Range("A" & r2)
End With
Application.ScreenUpdating = True
End Sub

解決方法：複数シートに転記する方法

このコードを複数シートに転記するために、いくつかの変更を加える必要があります。具体的には、複数のシートをループで回し、それぞれにデータを転記する方法です。

Sub 転記() 
Dim sh As Worksheet, ws As Worksheet
Dim r1 As Long, r2 As Long
Application.ScreenUpdating = False
Set sh = Worksheets("シート1")
r2 = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1
For Each ws In Worksheets
 If ws.Name <> "シート1" Then
  ws.Range("A16:BM" & ws.Cells(Rows.Count, "A").End(xlUp).Row).Copy Destination:=sh.Range("A" & r2)
 End If
Next ws
Application.ScreenUpdating = True
End Sub

コードの説明

この改良されたコードでは、まずシート1のデータを参照し、次にすべてのシートをループして、シート1以外のシートに転記します。`For Each`ループを使用して、`Worksheets`コレクション内のすべてのシートをチェックし、`シート1`以外のシートにデータをコピーします。

まとめ：複数シートへの転記方法

Excel VBAを使って、複数のシートにデータを転記する方法は、シートをループして条件を加えたコードを書くことで簡単に実現できます。上記のコードを参考にして、他のシートにも簡単にデータを転記できるようになります。