マクロ・複数シートに適用するには？

質問

初心者です。以下のマクロを組みました。
これを複数シートに適用するにはどうしたらよいのでしょうか？
worksheets selectではうまくいきませんでした＞＜
具体的には１～８０までのシートが数字で分けられており、
「目次」と「新規」以外の全てに適用したいです。

Sub Macro3()
Dim sl As String
Dim mySht As Worksheet

sl = Range("A65536").End(xlUp).Address
Range("B1", sl).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
For Each mySht In Worksheets

Next
End Sub

回答No.4

Wendy02 · ベストアンサー

元のコードを直してみました。
'-------------------------------------------
Sub Macro3r()
　　Dim sl As Range
　　Dim mySht As Worksheet
　　For Each mySht In Worksheets
　　　　With mySht
　　　　　　If .Name <> "目次" And .Name <> "新規" Then
　　　　　　　　Set sl = .Range("A65536").End(xlUp)
　　　　　　　　.Range("B1", sl).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
　　　　　　End If
　　　　End With
　　Next
End Sub
'-------------------------------------------
''以下は、私の書き方です。
''標準モジュール
'-------------------------------------------
Sub Test1()
　　Dim mySht As Worksheet
　　Dim r As Range
　　Const bOPN As Boolean = True 'True=隠す, False=戻す

　　For Each sh In ActiveWorkbook.Worksheets
　　　　With sh
　　　　　　If Not (.Name Like "目次" Or .Name Like "新規") Then
　　　　　　　　On Error Resume Next 'ブランクセルを探すためには、これが必要
　　　　　　　　Set r = .Range("B1", .Cells(Rows.Count, 1).End(xlUp)) _
　　　　　　　　.SpecialCells(xlCellTypeBlanks)
　　　　　　　　If Not r Is Nothing Then
　　　　　　　　　　r.EntireRow.Hidden = bOPN
　　　　　　　　End If
　　　　　　　　On Error GoTo 0
　　　　　　End If
　　　　End With
　　Next
End Sub

'=========================================
Name やCell, Rangeプロパティの前には、すべて、「.(カンマ)」が入って、With ステートメントで、親オブジェクトを指定しています。

このように、SpecialCells(xlCellTypeBlanks)は、Blank がない場合を想定しなければなりませんが、Blankがない場合は、「実行時エラー」が発生します。それに、On Error Resume Next が必要になります。
また、最後に、r オブジェクトの開放はしていませんが、この程度は、あまり気にしなくて良いです。

なお、本来のコードのB1 ～A列の最後までというのは、少しヘンですね。

B列なら、
Set r = .Range("B1", .Cells(Rows.Count, 1).End(xlUp).Offset(, 1)) _

このようになります。
Rangeの引数は、"B1"の文字列でよいですが、もうひとつの範囲の引数は、オブジェクトで構いません。

回答No.3

keithin

再掲：
＞「どのシートの」セルを使っているのか，マクロの隅々まで良く目を光らせて
＞間違えないよう気を付けます。

この書きぶりは間違いです：
＞Range("B1", sl).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
　↑　　↑　　↑

最初のrange，中に書いた"B1"，そしてslと３箇所，明示的にシートを指定していないのでアクティブシートだけを対象に(シートの枚数の回数を）ぐるぐると同じ事を繰り返しています。

しかも特に「("B1", sl)」と書いた部分は，省略した書き方を変な風に憶えて使っているので，ますます間違いに気づきにくくなっています。

解決策は回答したとおりですが，
＞これにすると隠れて欲しくないところまで隠れてしまいました

どのような不都合があったのか，問題点を具体的なエクセルの姿としてはっきり教えてください。

また，回答されたマクロの文言をコピーして問い返すのではなく，　　必　ず　　あなたが実際に動かして失敗したマクロをコピーして改めて掲示し，写し間違いや読み取り間違いで余計なミスを抱えていないかもチェックしてもらうよう気を付けるようなさってください。

回答No.2

watabe007

>s.range("B1:B" & s.range("A65536").end(xlup).row).entirerow.hidden = true
>これにすると隠れて欲しくないところまで隠れてしまいました＞
質問ではB1からA列の最終行までだったのでは
>sl = Range("A65536").End(xlUp).Address
>Range("B1", sl).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True

>s.range("B1:B" & s.range("A65536").end(xlup).row).entirerow.hidden = true
↓
s.Range("B1", s.Range("A65536").End(xlUp)).EntireRow.Hidden = True

補足

ありがとうございます。
言葉が足りずすみません＞＜
B列にある空白行を隠すという設定にしたいので
sl = Range("A65536").End(xlUp).Address
Range("B1", sl).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
これは合っているようです。。
ですが、一つのシートにしか適用されず困っております＞＜

回答No.1

keithin

sub macro3r1()
　dim s as worksheet

　for each s in worksheets
　　if s.name <> "目次" and s.name <> "新規" then
　　　s.range("B1:B" & s.range("A65536").end(xlup).row).entirerow.hidden = true
　　end if
　next
end sub

みたいな。

＃「どのシートの」セルを使っているのか，マクロの隅々まで良く目を光らせて間違えないよう気を付けます。

補足

ありがとうございます。
以下のようにしたのですが、一つのシートにしか適用されませんでした＞＜どこが悪いのでしょうか？

Dim sl As String

For Each s In Worksheets
If s.Name <> "目次" And s.Name <> "新規" Then
sl = Range("A65536").End(xlUp).Address
Range("B1", sl).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True

End If
Next
End Sub

あと、
s.range("B1:B" & s.range("A65536").end(xlup).row).entirerow.hidden = true
これにすると隠れて欲しくないところまで隠れてしまいました＞＜