ファイルオープン時のマクロが一部実行されない

質問

いつも回答して頂き、ありがとうございます。感謝感謝です。
ファイルオープン時にApplication.Runで３つのマクロを実行させているのですが、最後のマクロだけ実行されません。どうしてでしょうか？もしかして、前の２つで『一覧シート』を除外するマクロを実行しているからでしょうか？御指導の程宜しくお願いいたします。

1番目に実行するマクロ
Sub 特定のシート以外の最終履歴と次回予定日を算出する()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "一覧" Then
If ws.Name <> "メニュー" Then
Dim c As Integer
c = 3
Do While ws.Cells(2, c).Value <> ""
With ws.Cells(6, c)
.FormulaR1C1 = "=MAX(R8C:R10000C)"
If .Value = 0 Then
.Value = "履歴無し"
ws.Cells(7, c).ClearContents
Else
.Value = .Value
ws.Cells(7, c) = DateAdd("d", ws.Cells(5, c), DateAdd("m", ws.Cells(4, c), DateAdd("yyyy", ws.Cells(3, c), ws.Cells(6, c))))
End If
End With
c = c + 1
Loop
End If
End If
Next
End Sub

２番目に実行するマクロ
Sub 期限の未達と到達を色で分ける()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name <> "一覧" Then
If ws.Name <> "メニュー" Then

Dim c As Long
Dim res As Variant

For c = 3 To ws.Cells(7, Columns.Count).End(xlToLeft).Column
If IsDate(ws.Cells(7, c)) Then
If ws.Cells(7, c) > Date Then
res = 8
Else
res = 3
End If
Else
res = xlNone
End If
ws.Cells(7, c).Interior.ColorIndex = res
Next c
End If
End If
Next
End Sub

３番目に実行するマクロ
Sub 各シートの情報を一覧へ転記する()
Dim d As Integer
Dim retu As Integer
d = 3
Do While Cells(d, 2).Value <> ""
With Worksheets(Worksheets("一覧").Cells(d, 2).Value)
.Activate
retu = .Range("IV7").End(xlToLeft).Column
.Range(Cells(7, 3), Cells(7, retu)).Copy
End With
With Worksheets("一覧")
.Activate
Cells(d, 3).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
d = d + 1
Loop
End Sub

回答No.1

tsubuyuki · ベストアンサー

直接の回答にはならないかもしれませんが・・

> d = 3
> Do While Cells(d, 2).Value <> ""

「どのシートの」Cells(d, 2)が空白になるまででしょう？

お礼

完璧にエラー要因に直結している回答をして頂きありがとうございました。
シートが選択されていないので、動作が正常に行われていなかったんですね。対象のシートをアクティブにする事で問題は解決しました。

以前の質問でActivateの記述があまり意味がないかも？って説明がありましたが、どういう事でしょうか？ちなみに下記の文章で意味がないかも？のActivateを使用しているので、今後の為に有効な記述例を挙げて頂けないでしょうか？宜しくお願い致します。

Sub 各シートの情報を一覧へ転記する()
Dim d As Integer
Dim retu As Integer
Worksheets("一覧").Activate
d = 3
Do While Worksheets("一覧").Cells(d, 2).Value <> ""
With Worksheets(Worksheets("一覧").Cells(d, 2).Value)
.Activate'あまり意味がない箇所
retu = .Range("IV7").End(xlToLeft).Column
.Range(Cells(7, 3), Cells(7, retu)).Copy
End With
With Worksheets("一覧")
.Activate 'あまり意味がない箇所
Cells(d, 3).PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End With
d = d + 1
Loop
End Sub

回答No.4

tsubuyuki

かまいませんよ（笑）。
私もここ、Withの理解には苦しみましたので、よくわかります（笑）。
ちなみに今でもちょくちょく間違えます（苦笑）。

さてさて、結論から言うと、
> 『.Cells(Cells(7, 3), Cells(7, retu)).Copy』
これは構文的になんとなくおかしいですね。
　　.Range(Cells(7, 3), Cells(7, retu)).Copy
とします。

ただしこの場合、.Range（　）の中がポイントです。
この「Range」に関しては、「．（ピリオド）」がついてますから、
Withで指定されたオブジェクト（この場合はシート）のRangeなのだとVBAもちゃんと理解します。

ですが、中身の「Cells」には「．（ピリオド）」がついていませんから、
VBAは「アクティブシート」の「Cells(7, 3)」を見に行ってしまいます。

この時、Withで指定されたシート（シート「い」とします）がアクティブであれば良いですが、
その他のシート（シート「ろ」とします）がアクティブだった場合、VBAは
　　Worksheets("い").Range(Worksheet("ろ").Cells(7, 3),Worksheet("ろ").Cells(7, retu))
読み取ると“「い」シートの中の「ろ」シート７行目・３～retu列目の範囲」と言う判断をします。
シート「い」の中にシート「ろ」のセル番地があるはずがないですから、これはエラーを返してきます。

回避するには「Cells」も「い」シートのセルを指定しているを言うことを言い聞かせてやる必要があります。
　　Worksheets("い").Range(Worksheet("い").Cells(7, 3),Worksheet("い").Cells(7, retu))
こうすると、VBAも素直に「い」シートの中だけで処理をしてくれます。
が、えらく長いので、Withでまとめてシンプルにしましょう。
　　With Worksheets("い")　　　
　　　　.Range(.Cells(7, 3), .Cells(7, retu))　　'この行が今回の結論（．Ｃｅｌｌｓ）
　　End With
最終的に、ここに落ち着きます。
括弧の中の二つのCellsにも「．（ピリオド）」をつけることにより、
Withで指定したシートを見に行きなさい、と命令してやるんですね。

お礼

回答ありがとうございました。
選択の範囲を示している『Cells』も『With』で省略されている記述があるから、『Cells』の前にピリオドを付けないと駄目だったんですね。やっぱり難しいな。とっても分かり易く説明して頂き感謝です。

回答No.3

tsubuyuki

> それともこの『Range(Cells(7, 3), Cells(7, retu)).Copy』記述が悪いのでしょうか？

そうそう、それがまさに

>> が、いまさらですが、この記述だとちょっとうまくないですね（笑）。
>> 　　　　.Range(.Cells(7, 3), .Cells(7, retu)).Copy
>> ここも「.Cells」にしてやらないと、ですね（笑）。すいません（苦笑）。

この部分です。

これをしておかないと、Cells(　　)も「今のアクティブシート」を見ちゃいますね。

　　.Range(Cells(7, 3), Cells(7, retu)).Copy

だと、「処理したいシートの“アクティブシートのC7セルから～”」と言う難しい範囲選択の意味になっちゃうんですね。

なので、Withで指定したシートのセルですよ、ってことで「.Cells(　　）」にしてやりましょう。

お礼

すみません。理解できません。アホな子と思わず聞いてください。
『.Range(Cells(7, 3), Cells(7, retu)).Copy』の文を、『.Cells(Cells(7, 3), Cells(7, retu)).Copy』にしてって事でしょうか？これはエラーが発生しました。
とっても駄目な子と思ってくれて良いので、幼い子でも分かるように説明して頂けないでしょうか？宜しくお願い致します。

回答No.2

tsubuyuki

一質問・一案件（笑）。
まぁ、気を取り直して（笑）。

　　d = 3
　　With Worksheets(Worksheets("一覧").Cells(d, 2).Value)
　　　　.Activate'あまり意味がない箇所
　　　　retu = .Range("IV7").End(xlToLeft).Column
　　　　.Range(Cells(7, 3), Cells(7, retu)).Copy
　　End With

Withを使って「どこ（何）に対する処理」と宣言しているので、
上記であれば４・５行目はこの「どこに対する」が明確です。
なのでわざわざWithで指定したシートをアクティブにする必要がありません。
他のシートがアクティブでも、Withで指定したシートに対して処理が進みます。
が、いまさらですが、この記述だとちょっとうまくないですね（笑）。
　　　　.Range(.Cells(7, 3), .Cells(7, retu)).Copy
ここも「.Cells」にしてやらないと、ですね（笑）。すいません（苦笑）。

同様にその後の処理

　　With Worksheets("一覧")
　　　　.Activate 'あまり意味がない箇所
　　　　Cells(d, 3).PasteSpecial Paste:=xlPasteAllExceptBorders, _
　　　　　　　　　　　　　　　　　　Operation:=xlNone, _
　　　　　　　　　　　　　　　　　　SkipBlanks:=False, _
　　　　　　　　　　　　　　　　　　Transpose:=False
　　　　Application.CutCopyMode = False
　　End With

ここも同様に、「.Cells(d,3)」と書いてやれば、.Activateは実は不要なのです。
ってことは、Withも要らないぽいですね。ついでに省略できるところは省略。
　　Worksheets("一覧").Cells(d, 3).PasteSpecial Paste:=xlPasteAllExceptBorders
　　Application.CutCopyMode = False
これで事足ります。

Withを使わずに全て（簡略に）記述するなら、Activateが必要です。
例えば

　　d = 3
　　Worksheets(Worksheets("一覧").Cells(d, 2).Value).Activate
　　　　retu = Range("IV7").End(xlToLeft).Column
　　　　Range(Cells(7, 3), Cells(7, retu)).Copy

こんな感じでしょうか。
この場合は３列目以降のRangeに「どのシートの」の指定が無いので、
現在のアクティブシートを見てしまいます。
なので念のために、目的のシートを事前にアクティブにするために、Activateを使います。

またはワークシートを変数においてしまうのも手段の一です。

　　Dim WS as Worksheet
　　d=3
　　Set WS=Worksheets(Worksheets("一覧").Cells(d, 2).Value)
　　　　retu=WS.Range("IV7").End(xlToLeft).Column
　　　　WS.Range(WS.Cells(7, 3), WS.Cells(7, retu)).Copy

この他にもいろいろな書き方があるでしょうが、ここから先は本当に好みによります。
色々な書き方を試して、自分が書きやすいものを使うと良いと思います。
で、そのうちに「早く処理するためにはどう書いたらいいか？」に悩むようになりますから（笑）。

お礼

回答ありがとうございます。
下記のマクロActivateを抜いて記述しましたが、エラーが発生しました。文の構成が悪いのでしょうか？それともこの『Range(Cells(7, 3), Cells(7, retu)).Copy』記述が悪いのでしょうか？御指導の程宜しくお願い致します。

　　d = 3
　　With Worksheets(Worksheets("一覧").Cells(d, 2).Value)
　　　　.Activate'あまり意味がない箇所
　　　　retu = .Range("IV7").End(xlToLeft).Column
　　　　.Range(Cells(7, 3), Cells(7, retu)).Copy
　　End With