Mirroring Range of Cells in Between Sheets

Issue

Sheet1

  Private Sub Worksheet_change(ByVal Target As Range)
    
    If Not Intersect(Target, Range("B93")) Is Nothing Then
       If Target = Range("B93") Then
          Sheets("Sheet2").Range("A1").Value = Target.Value
       End If
    End If
    
    End Sub

Sheet2

Private Sub Worksheet_change(ByVal Target As Range)

If Not Intersect(Target, Range("A1")) Is Nothing Then
  If Target = Range("A1") Then
    If Sheets("Sheet1").Range("B93").Value <> Target.Value Then
      Sheets("Sheet1").Range("B93").Value = Target.Value
    End If
  End If
End If

End Sub

The code works for only single cell on B93 and A1.

I tried setting the range to Range("B93:N122") on sheet1 and Range("A1:M22") on sheet 2 to mirror the ranges when changes happened but I get the error 13 mismatch.

Goal: I want to mirror the changes (two way) on range(A1:M22) sheet 1 to sheet 2 vice versa. What line of code am i missing?

Solution

Mirror Ranges

  • Values changed in cells of one worksheet will also change to the same values in the same cells of the other worksheet and vice versa.

Standard Module e.g. Module1

Option Explicit

Sub MirrorWorksheets( _
        ByVal Target As Range, _
        ByVal RangeAddress As String, _
        ByVal WorksheetName As String)
    
    Dim sws As Worksheet: Set sws = Target.Worksheet
    Dim irg As Range: Set irg = Intersect(sws.Range(RangeAddress), Target)
    If irg Is Nothing Then Exit Sub
    
    Dim dws As Worksheet: Set dws = sws.Parent.Worksheets(WorksheetName) 
    
    Application.EnableEvents = False
    
    Dim iarg As Range

    For Each iarg In irg.Areas
        dws.Range(iarg.Address).Value = iarg.Value
    Next iarg

    Application.EnableEvents = True
    
End Sub

Sheet1 Module

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    MirrorWorksheets Target, "A1:M22,B93:N122", "Sheet2"
End Sub

Sheet2 Module

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    MirrorWorksheets Target, "A1:M22,B93:N122", "Sheet1"
End Sub

Answered By – VBasic2008

Answer Checked By – Marie Seifert (AngularFixing Admin)

Leave a Reply

Your email address will not be published.