| 
    
     |  | こういうことですか? 骨格だけとお考え下さい。
 
 Sub test()
 Dim x As Long
 Dim y As Long
 
 x = Application.InputBox(prompt:="先頭の番号を入力してください")
 y = Application.InputBox(prompt:="最終の番号を入力してください")
 
 k = 1
 For i = x To y
 Worksheets("Sheet1").Range("B4").Value = Worksheets("Sheet3").Cells(i + 2, 3).Value
 Worksheets("Sheet1").Range("C30:F30").Copy
 k = k + 1
 Worksheets("Sheet2").Cells(k, 1).PasteSpecial Paste:=xlPasteValues
 For j = 1 To 4
 If Worksheets("Sheet2").Cells(k, j).Value = 0 Then
 Worksheets("Sheet2").Cells(k, j).ClearContents
 End If
 Next
 Next
 End Sub
 
 |  |