エクセルVBAの別sheetの空白行削除について

質問

エクセル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 マクロ()
'下記よりsheet1とsheet2の内容をsheet3にコピーする
Worksheets("sheet1").Range("C1:BE50").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50")

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

'下記より上記sheet3の状態から余分な空白行を削除する
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のセルを変更すると
エクセルが固まってしまいます。
デバックでは
Rows(RowCount).Delete
がよくないようです。
書き方が間違っているのでしょうか？

回答No.3

keithin · ベストアンサー

同じ事を何度も言うのは全く気が引けるのですが，このままではマルで先に進みません。
具体的な確認のポイントは，既に沢山の行数を費やしてご説明済みですが，まるっきりスルーされてしまいました。
「ダメでした」じゃ，いったい何をどう確認してどこがどうダメだったのか，全然情報がありませんので説明のとっかかりもありません。

再掲：
「正しく動く」姿を理解するため，まず次の通りに手を動かしてください。
１．まっさらのブックを一つ用意する
２．「シートあ」と「シートい」「シートう」のシートモジュールにマクロを登録する
３．標準モジュールを追加しマクロを登録する
４．シートあ，い，うに何かサンプルでデータ（数字や文字）を記入する
５．データを記入した行が，空白行を省いて「実行シート」に自動でコピーされる様子を確認する。

特に手順の４および５が確認できていないと推測されます。
あなたの実際のエクセルが，上述で動作確認したサンプルと何がどうちがうのかよく観察し，必要に応じて必要な箇所を（シートの内容を？マクロの記述を？適切に）修正してください。

次に。
あなたが試した「動かないエクセル」で「シートあ」のシートモジュールのマクロを次の通りに変更します
Private Sub worksheet_change(ByVal Target As Excel.Range)
stop
Call macro1
End Sub

「シートあ」に何か文字か数字を記入します
特にこの手順を行っていない可能性が推測されます

VBE画面でStop命令が自動で黄色反転したら，F8キーを連打してマクロを「ステップ実行」します
正しくmacro1に自動で実行が移り，さらに一行ずつ進行していくか確認します
以上の手順もちゃんと実行したのかどうなのか，さっぱり不明です。

回答No.2

keithin

＞マクロを実行しても何も起きません。
＞マクロは有効にしてあります。

動かない原因はさまざま考えつくので，今の乏しいご説明だけで「それならこれが原因だからこうしましょう」と特定する事はできません。

●シート１，シート２の具体的な姿について説明されていないのが原因かもしれません
●「マクロを実行する」方法が間違っているのかもしれません
●そもそもマクロを登録するところから何か判りませんが問題を起こしているのかも？しれません

「正しく動く」姿を理解するため，まず次の通りに手を動かしてください。
１．まっさらのブックを一つ用意する
２．Sheet1とSheet2のシートモジュールに先に回答したマクロを登録する
３．標準モジュールを追加し先に回答したマクロを登録する
４．シート１，シート２に何かサンプルでデータ（数字や文字）を記入する
５．データを記入した行が，空白行を省いてシート３に自動でコピーされる様子を確認する。

あなたの実際のエクセルが，上述で動作確認したサンプルと何がどうちがうのかよく観察し，必要に応じて必要な箇所を（シートの内容を？マクロの記述を？適切に）修正してください。

次に。
あなたが試した「動かないエクセル」でシート１のシートモジュールのマクロを次の通りに変更します
Private Sub worksheet_change(ByVal Target As Excel.Range)
stop
Call macro1
End Sub

シート１に何か文字か数字を記入します
VBE画面でStop命令が自動で黄色反転したら，F8キーを連打してマクロを「ステップ実行」します
正しくmacro1に自動で実行が移り，さらに一行ずつ進行していくか確認します

＃こういう動作確認を「デバッグ」と言います。
漫然とマクロを実行して「うごいたーとまったー」と一喜一憂するのではなく，いま動かしているマクロが一行ずつ正しく進行しているか，意図しない結果に終わったときはどこで道を間違えているのか，ご自分の手を動かして確認を必ず実行してください。

正しくmacro1が実行され終了し，なおかつ「意図した結果」が起こらないときは，シート１，２の具体的な姿や「実際の使い方」がご質問で正しく情報提供できていないのが原因です。
シート１や２で「具体的に何をしたとき」「どの行はコピーされる必要があり」「どの行はコピーされて欲しくない」のか，その具体的な理由と判断基準を「具体的なエクセルの姿によって」説明してください。その情報を使い，正しいマクロをイチから作り直す必要があります。

補足

詳しくアドバイスして頂き、ありがとうございます。
いろいろ試してみましたが、やはりダメでした。

↓その作業画面を画像にして、アップロードしました。
http://blog-imgs-17.fc2.com/s/k/s/sksfiosjdijf34/newfile_sample.html

回答No.1

keithin

間違いのその１：
今のマクロは，changeイベントが走った時点でのactivesheetに対して諸々処理をするマクロになってしまっています。少なくともそうじゃなく，Sheet3に対して削除なりをするように直す必要がありますね。

付随しての間違いのその２：
上述の結果，シート１／２の空行を削除してしまっています。するとそのアクションがまたchangeイベントをトリガします。結果してchangeイベントから「マクロ」マクロの呼び出しが多重で発生し，場合によってはスタックオーバーフローで停止します。

で。こんなカンジですかね。

シート１とシート２のシートモジュールに：
private sub worksheet_change(byval Target as excel.range)
call macro1
end sub

標準モジュールに：
sub macro1()
with worksheets("Sheet3")
　.cells.clearcontents
　on error resume next
　worksheets("Sheet1").range("C1:BE50").specialcells(xlcelltypeconstants).entirerow.copy _
　　destination:=.range("A1")
　worksheets("Sheet2").range("C1:BE100").specialcells(xlcelltypeconstants).entirerow.copy _
　　destination:=.range("A" & .usedrange.rows.count + 1)
end with
end sub

補足

ありがとうございます。
sheet1とsheet2の全ての情報をsheet3にコピーしてまとめ、
sheet1とsheet2の間にある空白行を削除する件ですが、
アドバイスをいただいたコードをそのままコピペしましたが
マクロを実行しても何も起きません。
マクロは有効にしてあります。

コピペしたコードの貼付場所はMicrosoft Excel Objectsのsheet1とsheet2に

Private Sub worksheet_change(ByVal Target As Excel.Range)
Call macro1
End Sub

といれ、

標準モジュールのModule1に

Sub macro1()
With Worksheets("Sheet3")
.Cells.ClearContents
On Error Resume Next
Worksheets("Sheet1").Range("C1:BE50").SpecialCells(xlCellTypeConstants).EntireRow.Copy _
Destination:=.Range("A1")
Worksheets("Sheet2").Range("C1:BE100").SpecialCells(xlCellTypeConstants).EntireRow.Copy _
Destination:=.Range("A" & .UsedRange.Rows.Count + 1)
End With
End Sub

を入れました。原因は何でしょうか・・・