| 
    
     |  | それではこういうことですか? 
 Sub test2()
 Dim i As Long
 Dim x As Long
 Dim y As Long
 Dim r As Range
 Dim c As Range
 
 x = Application.InputBox(prompt:="先頭の番号を入力してください")
 y = Application.InputBox(prompt:="最終の番号を入力してください")
 
 For i = x To y
 '>3列目の3行目からです。(him氏)
 Worksheets("Sheet1").Range("B4").Value _
 = Worksheets("Sheet3").Cells(i + 2, 3).Value
 
 '> 正確にはC30:C40,D30:D40,E30:E40までを転記させたいです。(him氏)
 'というと、こういうことでOK?
 Worksheets("Sheet1").Range("C30:F40").Copy
 
 'A列のデータあり最終行の次の行に、値のみ貼り付ける
 With Worksheets("Sheet2")
 Set r = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
 End With
 r.PasteSpecial Paste:=xlPasteValues
 
 '貼り付けたあとの各セルについて、0 なら 消去 する
 For Each c In r.Resize(11, 4)
 If c.Value = 0 Then
 c.ClearContents
 End If
 Next
 Next
 End Sub
 
 |  |