MENU

【ツール】複数シートのデータを1枚のシートにまとめる

ノーコードでこんなことできます

貼り付け先シートが無いときは、指定した名前のシートが、自動で作成されます。

・処理する範囲は、見出しの行を含めたり、含めなかったりできます。

・処理する範囲は、最終行までなど変化する範囲に対応します。

・連続トリガーを使い、前処理で「見出し行をコピー」したり、後処理でフィルターにより「見出し行を削除」できます。

動画(字幕を日本語にしてください。音声なし)

アプリのコード作成画面

f:id:The-Alchemist:20211228065826p:plain

コードの解説

 

シートの有無を調べる

Sub 複数シートを1枚にする()

'◆"全社計"シートがあるか調べる
Dim 貼付シート As Worksheet, あり As Boolean
For Each 貼付シート In Worksheets
  If 貼付シート.Name = "全社計" Then
     あり = True
     Exit For
  End If
Next 貼付シート

For Eachで、シートの名前に”全社計”があるか、すべてのワークシートを調べます。

これは、”全社計”が無いと、貼り付け先が無く、エラーになるためです。

仕組みは、 If~で、”全社計”シートがあった場合、”あり”に”True"というフラグを立てるとともに、残りのシートのチェックは無駄なので、Exit ForでこのFor Each処理を終了します。

シートが無ければ追加

'◆無ければ全社計"シートを追加

If あり = False Then
   Worksheets.Add before:=Worksheets(1)
   ActiveSheet.Name = "全社計"
End If

変数”あり”は Boolean型で初期値はFalseです。”あり”に”True"フラグが立たなかった場合は、1番目のワークシートの前に新しいワークシートを追加し、名前を”全社計”とします。

自シートを対象外にする

'◆シートが"全社計"ではない場合、"全社計"にデータを貼り付ける
Dim シート As Worksheet
For Each シート In Worksheets
  If シート.Name <> "全社計" Then

"全社計”シートのデータを”全社計”シートに貼り付けると、データが2重になります。そこで、”全社計”シートをコピー対象から除外<>しています。

 コピーするセル範囲を取得

Dim 右下セル As String, セル範囲 As String
シート.Select
'◆最終行を取得し、セル範囲を決める
Range("a2:g2").CurrentRegion.Select
With Selection
  右下セル = Cells(.Row + .Rows.Count - 1, Range("g1").Column) _
  .Address(False, False)
End With
セル範囲 = "a1" & ":" & 右下セル

上の例は、範囲オプションで「最終行まで」を選んだ場合です。

範囲オプションを選ばずない場合は、下記のとおりです。

シート.Select
セル範囲 = "a2:g10"

セル範囲を、目的のシートの末尾に貼る

シート.Range(セル範囲).Copy Worksheets("全社計").

Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

シート.Range(セル範囲).Copy で”セル範囲”をコピーし、

Worksheets("全社計").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)で、

”全社計”シートの最後の行一つ下にコピーしています。

”全社計”シートか否かの条件分岐を終わらせ、次のシートに移る

  End If
Next シート

End IfでIfを閉じ、Next シートで次のシートをチェックします。

最後に

Worksheets("全社計").Activate

End Sub

そして、最後に”全社計”シートをアクティブにし、終了します。

 

アプリはこちらから↓↓↓↓