エクセル ＶＢＡ 繰り返し コピー貼り付け

以下を繰り返し作業をOffsetを使用して行いたいのですがどうすればいいでしょうか？
Sheets("Sheet1").Select
Range("A1:C1").Select　のA1:C1以下へA1000:C1000ぐらいあります。
Sheets("Sheet2").Select
Range("G1").Select　は貼り付けたセル3つの数字の組み合わせで公式に使う計算期間がまちまちですので公式を張り付けたり出来ません。
D1の解を
heets("Sheet1").Select
Range("D1").Select　に貼り付けてA1:C1以下1000までの結果を評価出来るようにしたいのですが！

' Macro1 Macro
Sheets("Sheet1").Select
Range("A1:C1").Select
Selection.Copy
Sheets("Sheet2").Select
Range("D1").Select
ActiveSheet.Paste
Range("G1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("D1").Select
ActiveSheet.Paste
Range("A2:C2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("D1").Select
ActiveSheet.Paste
Range("G1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("D2").Select
ActiveSheet.Paste
Range("A3:C3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet2").Select
Range("D1").Select
ActiveSheet.Paste
Range("G1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("D3").Select
ActiveSheet.Paste
End Sub

よろしくおねがいします。

No.2 ベストアンサー 回答者： hige_082 回答日時： 2008/12/16 23:46

Offsetはこのような処理では、一般的ではないと思います

Sub test()
Dim i As Long
For i = 1 To 1000
Sheets("Sheet1").Select
Range(Cells(i, 1), Cells(i, 3)).Select
Selection.Copy
Sheets("Sheet2").Select
Range("D1").Select
ActiveSheet.Paste
Range("G1").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Cells(i, 4).Select
ActiveSheet.Paste
Next i
End Sub

この回答へのお礼

ありがとうございました。
目的が達成されました、説明不足の部分をご推察いただき
ご理解の上、完璧な回答に感謝いたします。
これで、過去のデータ検証が１時間で出来るようになりました。
本当にありがとうございました。

お礼日時：2008/12/21 07:47

No.3 回答者： n-jun 回答日時： 2008/12/17 12:16

コードもですが、やりたい事もレイアウト等を用いて提示された方が伝わるかと。

参考URL：http://okwave.jp/qa4554230.html

この回答へのお礼

以後、気をつけるように致します。
ありがとうございます。

お礼日時：2008/12/21 07:48

No.1 回答者： CoalTar 回答日時： 2008/12/16 23:29

>Range("G1").Select　は貼り付けたセル3つの数字の組み合わせで

>公式に使う計算期間がまちまちですので公式を張り付けたり出来ません。
公式って何ですか？ 解の公式のようなものでしょうか？

>Range("D1").Select　に貼り付けてA1:C1以下1000までの結果を
>評価出来るようにしたいのですが！
評価ってなんでしょう？ 成績をつけるのでしょうか？

そのまま、1000行までマクロを実行させるなら
Dim n As Integer
For n = 1 To 1000
Sheets("Sheet1").Select
Range("A" & n & ":C" & n).Select
Selection.Copy
Sheets("Sheet2").Select
Range("D" & n).Select
ActiveSheet.Paste
Range("G" & n).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("D" & n).Select
ActiveSheet.Paste
Next n
でしょうけど、何をしたいのかさっぱりわかりません。
(もちろん、こんなマクロは実行させないと思います)

この回答へのお礼

ありがとうございました。
参考にさせていただきました。

お礼日時：2008/12/21 07:43