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
補足
下の記述とうりですか? 整理番号が出ませんよ? どこか間違っていますか Sub test() Dim numStart As Integer Dim numEnd As Integer Dim i As Integer numStart = InputBox(Prompt:="最初となるページ番号を入力してください。") numEnd = InputBox(Prompt:="最終となるページ番号を入力してください。") For i = numStart To numEnd Range("D47") = Format(i, "0000") ActiveSheet.PrintOut Next i End Sub