質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

Q&A

解決済

2回答

3884閲覧

vba 複数シートのデータを1つのシートに転記する方法

omotti

総合スコア14

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

0グッド

0クリップ

投稿2018/03/07 04:42

編集2018/03/07 07:25

前提・実現したいこと

ブック内の全てのシート(転記先シートを除く)のデータを、同じブック内のシートに転記する方法を教えてください。

各シートのデータは、「A17」セルから入力されており、
データの行数は各シートによって異なります。(最大でも15行くらいです)
転記させたいデータは、B・C列になります。

転記は、転記先シートの「A1」セルから転記させたいです。

ループでコードを作ってみましたが、
実行すると最初は上手く転記されますが、
途中で固まってしまいます。

ご教授宜しくお願い致します。

該当のソースコード

Sub 転記() Dim j As Long Dim i As Long Dim cnt As Long cnt = 1 For j = 2 To ThisWorkbook.Worksheets.Count For i = 17 To Worksheets(j).Range("B17").End(xlDown).Row Worksheets(1).Cells(cnt, 1).Value = Worksheets(j).Cells(i, 2).Value Worksheets(1).Cells(cnt, 2).Value = Worksheets(j).Cells(i, 3).Value cnt = cnt + 1 Next i Next j End Sub

補足情報(FW/ツールのバージョンなど)

ここにより詳細な情報を記載してください。

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

guest

回答2

0

ベストアンサー

その程度で固まるというのは、不思議ですね。
シート数がよほど多いとか、計算式が多くあるとか、変更時のイベントがあるとか、でしょうか。

とりあえず、描画停止、イベント抑制、手動計算にしてみてはどうでしょうか。

あと、セル毎に代入するよりRangeごと代入したほうが高速ですね。

vba

1public Sub 転記() 2 Dim j As Long 3 Dim r As Long 4 Dim cnt As Long 5 6 Application.ScreenUpdating = False '描画停止 7 Application.EnableEvents = False 'イベント抑制 8 Application.Calculation = xlCalculationManual '手動計算 9 10 cnt = 1 11 For j = 2 To ThisWorkbook.Worksheets.Count 12 13 r = Worksheets(j).Range("B17").End(xlDown).Row - 16 14 Worksheets(3).Range("A" & cnt).Resize(r, 2).Value _ 15 = Worksheets(j).Range("B17").Resize(r, 2).Value 16 cnt = cnt + r 17 18 Next j 19 20 Application.ScreenUpdating = True 21 Application.EnableEvents = True 22 Application.Calculation = xlCalculationAutomatic 23End Sub

投稿2018/03/07 07:01

hatena19

総合スコア33620

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

omotti

2018/03/07 08:15

試したところエラーになってしまいましたが、 あるシートまでは上手く転記することができていたので、 そのシートを見たところ、データが1行しかありませんでした。 「.Cells(Rows.Count, "B").End(xlUp).Row」に変更したところ、 無事実行することができました。 恥ずかしながら初歩的なミスが原因でした。 お手伝いいただきありがとうございました。 コード使わせていただきます!
guest

0

矩形領域をRange()で指定して一発でコピーした方がいいパターンですね。
こんな感じのコードをループで必要なワークシート分回せば。

VBA

1Worksheets(1).Range( Worksheets(1).Cells(row1, col1), Worksheets(1).Cells(row2, col2) ).Select 2Application.Selection.Copy 3Worksheets(2).Range( Worksheets(2).Cells(row1, col1), Worksheets(2).Cells(row2, col2) ).Select 4Application.Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

ループの途中で固まる場合は、DoEventsを適度に挟んであげるか、
コピーするシート上に計算式がいっぱい仕込んであるのだとしたら
Application.Calculation = xlCalculationManualで自動再計算を止めてから処理するか。
データを転記するたびに自動再計算が走ってしまうと無駄ですので。

投稿2018/03/07 05:04

編集2018/03/07 05:10
退会済みユーザー

退会済みユーザー

総合スコア0

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問