エクセル マクロの効率化について

質問

皆様のお力添えを頂戴したく質問致します。
下記のようなマクロを作成し、現在業務で使用しております。
しかし、動作にかなりの時間を要する為、効率化を検討しましたが、どのように改善すべきかわかりません。本来は自分で勉強して行うべきであることは重々承知しておりますが、今回はなにぶん時間がなく、明後日までにどうにかしたいということもあるため、こちらに質問致しました。

どなたか詳しいかたがいらっしゃいましたらご教示頂けたらと思います。
よろしくお願い致します。

　　Dim r As Range
Set r = Intersect(Range("B12", Cells(Rows.Count, 2).End(xlUp)).EntireRow, Range("P:X"))
r.Copy
Set r = Nothing
Worksheets("元帳").Select
Range("B2500").End(xlUp).Offset(1).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues
Worksheets("振替伝票").Select
Range("A1").Select

回答No.2

tom04

こんばんは！
Selectを多用されていますので、
↓のように変更してみてはどうでしょうか？

Dim r As Range
Set r = Intersect(Range("B12", Cells(Rows.Count, 2).End(xlUp)).EntireRow, Range("P:X"))
Application.ScreenUpdating = False '←この行を追加
r.Copy
Set r = Nothing
Worksheets("元帳").Select
Range("B2500").End(xlUp).Offset(1).Select
ActiveCell.PasteSpecial Paste:=xlPasteValues
Application.ScreenUpdating = True '←この行を追加
Worksheets("振替伝票").Range("A1").Select '←最後の2行をまとめる

※　検証していませんので、短縮しなかったらごめんなさいね。m(_ _)m

回答No.1

keithin

掲示されたマクロが，動作の遅い原因になっているとはちょっと考えにくいのですが，とりあえず次のマクロのようにしてみます。

sub macro1()
　dim r as range
　set r = worksheets("コピー元のシート名").range("P12:X" & worksheets("コピー元のシート名").range("B65536").end(xlup).row)
　worksheets("元帳").range("B2500").end(xlup).offset(1).resize(r.rows.count, 9).value = r.value
end sub

その上で
１．コピー元のシートで，
　Ctrl+Endを押して「最後のセル」にジャンプする
　明示的に使っている表範囲より随分遠くにジャンプしたら，
　最後のセルの行から明示的に使っている表範囲の最後の行までの行範囲を「行選択」し，「行削除」する
　必ずブックを保存し，閉じて，開き直す
　改めてCtrl+Endを押し，「最後のセル」が目に見える表の最後で留まっていることを確認する
　上手く出来なかったときは，出来るまでやり直す

２．貼り付け先の元帳シートでも，同じ手順を実行する

と行ってみて下さい。