シート間の値の貼り付け。 スマートにしたい。

質問

こんばんは。
エクセルのシート１の[d7]から
シート2の[最終行]からカウントした数分（下の場合はシート1[d7]の値をc列に3行分）貼り付けるには下記のコードでOKと伺ったのですが、
この作業を何度も繰り返しさせているうちに動作が重くなってしまったような気がするのでが、シート１の[b2](貼り付け時に日付)[b3]（VLOOKUPの計算式が入っているので値のみ）[b4]（時刻）の形式でシート２のそれぞれ、隣接するd,e,l列に3行づつ貼り付けたいのですが、
何か方法は、ありますでしょうか。（それぞれ貼り付けたい形式も異なります。）
n=3
Worksheets("Sheet1").Range("d7").Copy _
Destination:=Worksheets("Sheet2").Range("c65536").End(xlUp).Offset(1, 0).Resize(n, 1)

↓動作確認ができなくなってしまったので、試していないのですが、
上の式の値のみ貼り付け方法は下記でよいのでしょうか。

'値のみ貼り付け
Set WWR1 = Worksheets("Sheet1").Range("c7")
Set WWR2 = Worksheets("月度集計").Range("c65536").End(xlUp).Offset(1, 0).Resize(n, 1)
WWR2.Value = WWR1.Value
宜しくお願い致します。

回答No.1

nag0720 · ベストアンサー

動作が重くなるのはおそらくセルのCopy＆Pasteを何回も繰り返しているためだと思います。
Excelはコピーした情報を複数持てるので、何回もコピーするとメモリーを消費してしまいます。
対策は、コピー先の書式が列ごとに決まっているならあらかじめ書式を列単位に設定しておいて、セルの値だけをコピーしたほうはいいでしょう。
どうしても書式をコピーしたいのであれば、毎回ではなく最初に１回だけ書式をコピーしそれを保存しておいて、Pasteだけを複数回繰り返せば重くならないと思います。

値だけのコピーの場合のコードは、下記のとおりです。

Dim n As Integer
Dim p As Integer
n = 3
p = Worksheets("Sheet2").Range("C65536").End(xlUp).Row + 1
Worksheets("Sheet2").Cells(p, 3).Resize(n, 1).Value = Worksheets("Sheet1").Range("C7").Value
Worksheets("Sheet2").Cells(p, 4).Resize(n, 1).Value = Worksheets("Sheet1").Range("B2").Value
Worksheets("Sheet2").Cells(p, 5).Resize(n, 1).Value = Worksheets("Sheet1").Range("B3").Value
Worksheets("Sheet2").Cells(p, 6).Resize(n, 1).Value = Worksheets("Sheet1").Range("B4").Value