エクセルVBAでエラー、Changeの使い方が×？

質問

エクセルVBAでBOOK1のsheet1とsheet2とsheet3があり、
sheet1とsheet2の全ての情報をsheet3にコピーしてまとめるようにしました。
マクロを実行するには、Visual Basicを開いてF5を押しています。

それをsheet1かsheet2の中身の一部分でも変更すると
そのときに自動的にマクロが実行されるようにしたいです。

sheet1とsheet2とsheet3に

Private Sub Worksheet_Change(ByVal Target As Range)
Call マクロ()
End Sub

を入れ、

標準モジュールに

Sub マクロ()

Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50")

Workbooks("BOOK.xlsm").Worksheets("sheet2").Range("C1:BE100").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C51:BE150")

Dim UsedCell As Range
Dim Max_Row, RowCount As Integer

Set UsedCell = ActiveSheet.UsedRange

Max_Row = UsedCell.Cells(UsedCell.Count).Row
Application.ScreenUpdating = False
For RowCount = Max_Row To 1 Step -1

If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then
Rows(RowCount).Delete
End If
Next
Application.ScreenUpdating = True

End Sub

をやって、sheet1かsheet2のセルを変更すると
エクセルが固まってしまいます。
デバックでは最初の
Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50")
がよくないようです。
書き方が間違っているのでしょうか？

回答No.8

don9don9 · ベストアンサー

>この部分は削除しても動くので問題なさそうなのですが、
>削除して↓のコードで大丈夫ですよね？??

Sheet1やSheet2で、空白行を削除して上に詰める
必要がないのでしたら、削除しても大丈夫です。

Sheet1やSheet2で、1行空けて入力するとか
データを1行消す（※行削除ではなく）とかすると
ある場合とない場合の違いが分かると思います。

回答No.7

don9don9

No.3,4,6です。

今のマクロだと、ますアクティブシートの編集した範囲より上の空白行を削除して
それからSheet1の1行目から50行目の内容をSheet3の1行目から50行目に
Sheet2の1行目から100行目の内容をSheet3の51行目から150行目に
それぞれ転記すると思いますが、Sheet1とSheet2の間の空白が消えないということは
もしかして、Sheet1から転記したデータが50行に満たない場合は
51行目以降のSheet2から転記したデータをさらに上に詰めたいということでしょうか？

それなら、マクロの最後に

For RowCount = 150 To 1 Step -1
If Application.WorksheetFunction.CountA(Worksheets("sheet3").Rows(RowCount)) = 0 Then
Worksheets("sheet3").Rows(RowCount).Delete
End If
Next

（アクティブシートではなくSheet3固定で、150行目までの空白行を削除）
を追加すればいいのではないかと思います。

意図を取り違えていたらすみません。

お礼

ありがとうございます。
やりたいことが実現しました。

Dim UsedCell As Range
Dim Max_Row, RowCount As Integer

Set UsedCell = ActiveSheet.UsedRange

Max_Row = UsedCell.Cells(UsedCell.Count).Row
Application.ScreenUpdating = False
For RowCount = Max_Row To 1 Step -1

If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then
Rows(RowCount).Delete
End If
Next
Application.ScreenUpdating = True

この部分は削除しても動くので問題なさそうなのですが、
削除して↓のコードで大丈夫ですよね？??

Sub マクロ()

Worksheets("sheet1").Range("B1:BE50").Copy _
Destination:=Worksheets("sheet3").Range("B1:BE50")

Worksheets("sheet2").Range("B1:BE100").Copy _
Destination:=Worksheets("sheet3").Range("B51:BE150")

For RowCount = 150 To 1 Step -1
If Application.WorksheetFunction.CountA(Worksheets("sheet3").Rows(RowCount)) = 0 Then
Worksheets("sheet3").Rows(RowCount).Delete
End If
Next

End Sub

回答No.6

don9don9

No.3,4です。

私がNo.4に書いた方法は試されたのでしょうか。
マクロの前後に
Application.EnableEvents = False
と
Application.EnableEvents = True
を入れただけでは、No.5の補足に書いたような状態になるので
マクロでの処理を「空白行を詰める→Sheet3に転記」
の順番に変える、と書いたのですが。

補足

返事が遅れてしまい、すみません。

標準モジュールには、

Sub マクロ()

Dim UsedCell As Range
Dim Max_Row, RowCount As Integer

Set UsedCell = ActiveSheet.UsedRange

Max_Row = UsedCell.Cells(UsedCell.Count).Row
Application.ScreenUpdating = False
For RowCount = Max_Row To 1 Step -1

If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then
Rows(RowCount).Delete
End If
Next
Application.ScreenUpdating = True

Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50")

Workbooks("BOOK.xlsm").Worksheets("sheet2").Range("C1:BE100").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C51:BE150")

End Sub

そして、
Sheet1（VBAの）とSheet2（VBAの）には

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Call マクロ
Application.EnableEvents = True
End Sub

Sheet3（VBAの）は空白です。

このようにやると、
sheet1(エクセルの)とsheet2(エクセルの)の内容を変更すると、
sheet3(エクセルの)に
sheet1(エクセルの)の内容の下にsheet2(エクセルの)が
自動的にコピーされますが、
sheet1(エクセルの)とsheet2(エクセルの)の
間にある空白行が消えません。

回答No.5

nattocurry

> Private Sub Worksheet_Change(ByVal Target As Range)
> application.enableevents=false
> Call マクロ()
> application.enableevents=true
> End Sub
>
> こういうことでしょうか？

やってみた結果はどうでしたか？

補足

ありがとうございます。
試してみました。

結果は、sheet1とsheet2の内容を変更したとき自動でちゃんとsheet3にコピーされました。
しかし、
空白行は自動で削除されないため、
手動でマクロを実行しなければいけません。
実行すれば正しく空白行が削除されます。

回答No.4

don9don9

No.3です。
すみません、後半部分をよく見ていませんでした。
これは空白行を削除して上に詰めているのですね？
Sheet3にも、この詰めた状態で反映させたいのだとすると

・空白行の削除は、データのコピーの前に行う
>Dim UsedCell As Range
以降の部分を、マクロの最初に持ってくる

・マクロ実行時に、一時的にイベントが発生しないようにする
マクロの最初に　
Application.EnableEvents = False
最後に
Application.EnableEvents = True
を追加

この二点の修正でどうでしょうか。

No.3では、Sheet3の

>Private Sub Worksheet_Change(ByVal Target As Range)
>Call マクロ()
>End Sub

の部分を削除すればいい、と書きましたが
Sheet3を直接編集させたくないのであれば
入れたままにしておいていいです。

回答No.3

don9don9

>Private Sub Worksheet_Change(ByVal Target As Range)
>Call マクロ()
>End Sub

これをSheet3に入れてあるのがまずいのでは。

Sheet1またはSheet2のChangeイベントで、マクロが実行される。
↓
マクロによってSheet3の内容が書き換わる。
↓
Sheet3のChangeイベントが発生し、再度マクロが実行される。
↓
マクロによって再度Sheet3の内容が書き換わる。
↓
再度Sheet3のChangeイベントが発生。

こんな感じで無限ループしているわけです。

やりたいことの趣旨から考えると、Sheet3から
上記の部分を消すのが手っ取り早いと思います。

補足

ありがとうございます。
まさにその通りでした。
試してみると、
最初のエラーの部分を通り抜けました。
しかし、
最後から５行目の
Rows(RowCount).Delete
でエラーになってしまいます。

すみません、また教えて頂けないでしょうか。

回答No.2

nattocurry

この質問を読んだだけで、実際に検証していないので、間違っているかもしれませんが、、、

マクロの最初でコピーしたときに、コピー先の値が変わる(同じ値でも、上書きしているので、書き換えたことになります)ので、そのタイミングでまたチェンジイベントが発生してしまいます。

よって、最初のコピーを延々と無限に続けることになります。

最初のコピーよりも前に
application.enableevents=false
と書いて、イベントを発生させないようにしましょう。

マクロの最後で、
application.enableevents=true
と書いて、イベントを発生させるように戻すのを忘れずに。

間違っていたらごめんなさい。

補足

Private Sub Worksheet_Change(ByVal Target As Range)
application.enableevents=false
Call マクロ()
application.enableevents=true
End Sub

こういうことでしょうか？

回答No.1

mikemike01

sheet1とsheet2とsheet3に

Private Sub Worksheet_Change(ByVal Target As Range)
Call マクロ()
End Sub

----------------------------------------------------------

sheet3には不要なソースではないでしょうか？？？

補足

ありがとうございます。
まさにその通りでした。
試してみると、
最初のエラーの部分を通り抜けました。
しかし、
最後から５行目の
Rows(RowCount).Delete
でエラーになってしまいます。

すみません、また教えて頂けないでしょうか。