ファイルオープン時のマクロが一部実行されない
いつも回答して頂き、ありがとうございます。感謝感謝です。
ファイルオープン時に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
お礼
いつも教えて頂き感謝です。問題無く動作しました。 Andで結合したらいいんですね。ありがとうございました。