|
Sub T()
Dim i As Long
Dim T_Range As Range
i = 8
For Each T_Range In Sheets("元データ").Range("A4:A10")
MsgBox T_Range.Address & " のコピぺ開始"
Sheets("元データ").Select
T_Range.Copy 'Sheets("元データ").Range("A4").Copy
Sheets("冊子").Range("C" & i).PasteSpecial Paste:=xlValues
Sheets("元データ").Select 'PasteSpecialなので必要ない
MsgBox T_Range.Offset(0, 1).Address & " のコピぺ開始"
T_Range.Offset(0, 1).Copy 'Sheets("元データ").Range("B4").Copy
Sheets("冊子").Range("C" & i + 3).PasteSpecial Paste:=xlValues
i = i + 8
Next T_Range
End Sub
で、動きの確認してチョ
OKだったら、コードの整理をしてUPします。
|
|