セルの同期を取る

質問

Book内のシートの一部のセルにおいて、同期を取りたいです。
存在するシート名が、SheetA1,SheetA2,SheetB1,SheetB2,SheetC1,SheetC2の時、
SheetA1とSheetA2、SheetB1とSheetB2、SheetC1とSheetC2が、任意のセル範囲の値を共有したいです。
（SheetA1のセルA1に数字を入れたら、SheetA2のセルA1に同じ数字が入るように）
過去ログから以下のソースを見つけて「ThisWorkbook」に書き込んで使っていますが、
たまにエラーが起こって止まってしまいます。
必ず起こるわけではないのでエラーが起こる条件がいまいちわからないのですが、
起こる瞬間は、セルに数値を入力後、シートを切り替えた時に発生します。
（エラーが起こった時に数値を入力したセルは、同期を取っているセル範囲とは限りません）
エラーメッセージは、
実行時エラー'1004':
'Intersect'メソッドは失敗しました:'_Global'オブジェクト
です。
「ヘルプ」も見てみようと押してみたのですが、ウィンドウが開くだけで中身は表示されませんでした。
「デバッグ」を実行すると、※印をつけた
Set r = Intersect(Target, Range(CellRange))
の行が選択されます。

どういった条件でエラーが発生するのかわかりますでしょうか？

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim r As Range
Dim i As Integer
Dim ActSheet As String
Dim CellRange As String
ActSheet = ActiveWorkbook.ActiveSheet.Name '現在開いているシート名を取得
ActSheet = Left(ActSheet, 6) 'シート名の頭から５文字を取得

If ActSheet = "SheetA" Then '現在開いているシートがSheetA*の時に
CellRange = "A4:G3004" '同期を取るセルの範囲を指定
ElseIf ActSheet = "SheetB" Then
CellRange = "A3:E3003"
ElseIf ActSheet = "SheetC" Then
CellRange = "A4:F3004"
Else
Exit Sub
End If

Application.EnableEvents = False
If Target.Areas.Count = 1 Then '変更のあったセルが１つである場合
※ Set r = Intersect(Target, Range(CellRange))
If Not (r Is Nothing) Then
CopyToSheets r, ActSheet
End If
Else
For i = 1 To Target.Areas.Count '変更のあったセルが複数の場合
Set r = Intersect(Target.Areas(i), Range(CellRange))
If Not (r Is Nothing) Then
CopyToSheets r, ActSheet
End If
Next
End If
Application.EnableEvents = True
End Sub

Private Sub CopyToSheets(ByVal r As Range, ByVal ActSheet As String)
Dim Num As Integer
Dim OffSheet As String
For Num = 1 To 2
OffSheet = ActSheet & Num
Worksheets(OffSheet).Range(r.Address).Value = r.Value
Next
End Sub

回答No.2

fly_moon

>シートを切り替えた時に発生します。
Workbook_SheetActivateイベントでのエラーのように思うのですが、貼り付けられているコードはWorkbook_SheetChangeイベントですよね。

補足

回答ありがとうございます。

自分、「Workbook_SheetChange」が固定の名称であると今調べてわかったようなレベルなのですが、
この操作はWorkbook_SheetActivateで行うべきだ、という意味でしょうか？
シートを切り替えた時に発生するからWorkbook_SheetActivateのはずだが、貼り付けてあるコードがWorkbook_SheetChangeなのはおかしい、
という意味でしょうか？。

回答No.1

misaki____

わざわざマクロをくまなくても
sheet2のA1に
=IF(Sheet1!A1<>"",Sheet1!A1,"")
と書けば、同期がとれます。

補足

回答ありがとうございます。
申し訳ありません、書き忘れました。
同期させたいセル範囲が2000行あり、かつそれをCSV形式で出力したいので、
セル１つ１つに書いていくと何もデータを入れておかなくてもCSVにした時に「，」だけが2000行出力されてしまいます。
ファイル容量が増えるのでその方法は避けておりました。