Excel VBAのマクロについて

質問

以下のようなマクロを作りました。

P4に開始番号P6に終わりの番号があるのですが、P4＝P6、つまり、一つだけのシートを作成する分には問題なく動きます。しかしP4に1、P6に5と範囲を増やすとエラーが出て動きません。どこをなおしたらよろしいでしょうか？

Option Explicit

Sub 一括()

Dim I As Worksheet
Dim SheetName As String
Dim Prompt As String
Dim Col As Integer
Dim Cell As Range
Dim Row As Long
Dim hani As Long

For hani = Range("P4").Value To Range("P6").Value

Set I = ActiveSheet
SheetName = Cells(hani + 4, "K").Value & "(" & Cells(hani + 4, "B") & ")"
Prompt = SheetName & "が存在します。"
Sheets("基本シート").Copy After:=Sheets("基本シート")
On Error GoTo 100
ActiveSheet.Name = SheetName
On Error GoTo 0
Range("X3") = I.Cells(hani + 4, "B")
Range("E8") = I.Cells(hani + 4, "C")
Range("A13") = I.Cells(hani + 4, "D")
For Col = 0 To 8 Step 4
Set Cell = I.Cells(hani + 4, "D").Offset(, Col)

If Cell > 0 Then
Prompt = "該当する日付がありません。" & Cell.Address
On Error GoTo 100
Row = WorksheetFunction.Match(Cell, [A:A], 0)
On Error GoTo 0
Cells(Row, "E") = I.Cells(hani + 4, "E").Offset(, Col)
Cells(Row, "H") = I.Cells(hani + 4, "F").Offset(, Col)

If Col < 8 Then
Cells(Row, "Y") = I.Cells(hani + 4, "G").Offset(, Col)
End If
End If

Next Col
Next hani
End

100
If Err <> 1004 Then
Error Err
End
End If
MsgBox Prompt, vbCritical
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
Sheets(1).Select

End Sub

回答No.1

oboroxx · ベストアンサー

まずはどんなエラーがどの行で出るかを示しましょう。
ただ、エラーが出ます。見てください。では、回答する側の労力がすごく高くなります。
ある程度エラーを絞って提示してみてください。
そうすると、回答が付くと思いますよ。

補足

oboroxx 様
仰る通りですね、もうしわけありません。
現在以下のような状態です。
例えばP4に1、P5に1のように1つのみのマクロを実行した場合は、正常に作動します。

正常に機能しない場合の2つのうち1つ目は、P4に1、P5に2のように、
二つのマクロを実行しようとしたとき1つ目のは正常に作れていて、2つ目は基本シートのコピーで何も入力されていない状態で、名前だけが（）となっていました。

正常に機能しないパターンの二つ目は、P4に1、P5に5のように、3つ以上のマクロを実行しようとしたときです。この場合だと、先ほどの例と同じように、1つ目のは正常に作れていて、2つ目は基本シートのコピーで何も入力されていない状態で（本当はSheet1の指定したセルから転記されているはずなのですが）、名前だけが（）となり、3つ目のシートが”基本シート（2）という形で出来ているのですが、「（）が存在します」というメッセージが出た後、Okを押すと基本シート（2）が消え、1つ目の正常に作れたものと、2つ目の（）のファイルだけになりました。

回答No.2

oboroxx

当たっているかわかりませんが、

For hani = Range("P4").Value To Range("P6").Value
　Set I = ActiveSheet
　…
Next hani
となっていますが、ActiveSheetは、コピーされたシートに変わってしまって、2回目以降のhaniの値がコピーされたシートからCellsなどの値を取得でいいのでしょうか。
もしそれでダメなら、
Set I = ActiveSheet

For hani = Range("P4").Value To Range("P6").Value
　I.Activate
　…
Next hani

これで行けそうな気がします。