シートをまとめるマクロ

自分のところに書いておいて後でコピペで使う。便利だけど、DNSチェックとかいろいろ制限を受ける環境下ではメールサーバに置いておく方が良いんだよね。

といいつつ、今日縁あって作ったマクロ。

book内のシートを全部結合します。
積算ソフトから出力したbookとかだと使えるかもね。

‘##################
‘連結くん
‘##################
Sub jointSheets()
Dim sheetAll As Worksheet
Dim NumCurrRow As Long
Dim NumJoint As Integer
NumCurrRow = 1
NumJoint = 0

‘画面更新の停止
Application.ScreenUpdating = False

‘先頭にワークシートを1枚追加
Set sheetAll = Worksheets.Add(before:=Worksheets(1))
sheetAll.Name = “__ALL__”

For Each sh In Sheets
If sh.Name <> Worksheets(1).Name Then
sh.UsedRange.Copy
sheetAll.Cells(NumCurrRow, “A”).Select
sheetAll.Paste
NumCurrRow = NumCurrRow + sh.UsedRange.Rows.Count

NumJoint = NumJoint + 1
End If
Next

MsgBox NumJoint & “枚のシートを結合しました。”, vbOKOnly, “おしらせ”

sheetAll.Activate
sheetAll.Cells(1, “A”).Select

‘画面更新の再開
Application.ScreenUpdating = True

End Sub

実際使っていないので、動作確認はちゃんとやろう。
2003以前のexcelだと65536行を超えるとエラーになるでしょう。
また、__ALL__っていうシートが既にあると、確実にエラーです。