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
