全てのワークシートのレイアウト変更について

質問

いくつも全く同じレイアウトのエクセルシートがあります。この全てのシートのレイアウトをいっぺんに全く同様なレイアウト変更（ある場所のセル内容を別の場所にカット＆ペーストで移したい）したいのですが、マクロでどう書けばいいかお教え下さい。シート名を一つ一つ指定するやり方では実行できましたが、問題は一つのファイルのワークシートの数は毎回変更されるところです。因みにワークシート名（タブの部分）のネーミングルールは同じです（Plan(1), Plan(2)....Plan(n)となります）。以下に一つ一つ指定した場合のマクロを載せます。宜しくお願いいたします。
Sheets("PLAN(1)").Activate
Rows("29:31").Select
Selection.Delete Shift:=xlUp

ActiveWindow.LargeScroll ToRight:=-1
Range("j3:q28").Select
Selection.Cut
Range("a29").Select
ActiveSheet.Paste
Range("Q23").Select

Sheets("PLAN(2)").Activate
Rows("29:31").Select
Selection.Delete Shift:=xlUp

ActiveWindow.LargeScroll ToRight:=-1
Range("j3:q28").Select
Selection.Cut
Range("a29").Select
ActiveSheet.Paste
Range("Q23").Select
以下、同様です。

回答No.2

KenKen_SP · ベストアンサー

下記コードの書き方だと、シート名は問題になりません。

Sub Sample()

　　Dim SH As Worksheet

　　'画面の再描写を停止
　　Application.ScreenUpdating = False
　　'マクロが書かれたブック内の全シートでループ処理
　　'変数SHにはシートがひとつひとつセットされます
　　For Each SH In ThisWorkbook.Worksheets
　　　　'処理除外するシートがあればここで判定
　　　　'シート名で比較します
　　　　If SH.Name <> "除外シート" Then
　　　　　　'除外シートでなければ
　　　　　　With SH
　　　　　　　　'29～31行目を削除
　　　　　　　　.Rows("29:31").Delete Shift:=xlUp
　　　　　　　　'J3:Q28を切り取り、A29に貼り付け
　　　　　　　　.Range("J3:Q28").Cut Destination:=.Range("A29")
　　　　　　End With
　　　　End If
　　Next SH

End Sub

お礼

ありがとうございます。早速試してみてうまく動きました。すぐにご回答くださり、本当に助かりました。心よりお礼いたします。

回答No.1

hana-hana3

＞ワークシート名（タブの部分）のネーミングルールは同じです（Plan(1), Plan(2)....Plan(n)

Sub test()

Dim n As Integer, shn As String, i As Integer
n = 10 '最終番号

For i = 1 To n
shn = "PLAN(" & i & ")"
'処理
Sheets(shn).Activate
Rows("29:31").Delete Shift:=xlUp
Range("j3:q28").Cut Range("a29") '.Paste
Next

End Sub

で、いかがでしょう？

お礼

なるほど、シート名とシート数が分かっている場合にはこういう指定もできますね。確かにうまく動きました。ありがとうございます。