在Thisworkbook模块中：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
    Dim arrGroups, i As Long, m, tgt, arr, grp
    
    'all groups of cells to be synced
    arrGroups = Array(Array("Sheet1|D3", "Sheet2|B4"), _
                      Array("Sheet1|F3", "Sheet2|D4", "Sheet3|F7"))
    
    tgt = Sh.Name & "|" & Target.Address(False, False)
    
    For Each grp In arrGroups              'loop through the groups of synced cells
        m = Application.Match(tgt, grp, 0) 'matches one of the synced cells in this group?
        If Not IsError(m) Then
            On Error GoTo bm_Safe_Exit
            Application.EnableEvents = False
            For i = LBound(grp) To UBound(grp)
                If grp(i) <> tgt Then 'skip the cell raising the event...
                    arr = Split(grp(i), "|")
                    ThisWorkbook.Sheets(arr(0)).Range(arr(1)).Value = Target.Value
                End If
            Next i
            Application.EnableEvents = False
        End If
    Next grp
    
bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

编辑：添加了指定多个同步单元格组的能力

尝试使用两个这样的事件，每个事件对应一个相关的工作表：
假设在“Sheet1”中，要从“Sheet2”伪链接一个范围，请复制“Sheet1”代码模块中的下一个代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngA1 As Range, rngC5 As Range

    Set rngA1 = Range("A1")
    Set rngC5 = worksheets("Sheet2").Range("C5")

    If Not Intersect(Target, rngA1) Is Nothing Then
        Application.EnableEvents = False
          rngC5.Value = rngA1.Value
        Application.EnableEvents = True
    End If
End Sub

下一个在“Sheet2”代码模块中，将“C5”链接到Sheet1.Range("A1")：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngA1 As Range, rngC5 As Range

    Set rngA1 = worksheets("Sheet1").Range("A1")
    Set rngC5 = Range("C5")

    If Not Intersect(Target, rngC5) Is Nothing Then
        Application.EnableEvents = False
          rngA1.Value = rngC5.Value
        Application.EnableEvents = True
    End If
End Sub

我有个解决办法：1）必须为每组链接单元格的每个单元格创建工作表命名范围，命名约定如下：例如，对于组1，名称为：anything，anything.1，anything.2和anything.3，对于第二组，名称为LINK1，LINK1.1，LINK1.2 LINK1.3。这些工作表命名范围可以存在于任何工作表中，并且它们的名称在""之后必须不同。在每个工作表中必须具有如下代码：

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Union(Me.Range("LINK1"), Me.Range("LINK1.1"), Me.Range("LINK1.2"))) Is Nothing Then
      Call synchronizeLinkedCells(Target, "LINK1")
   End If
End Sub

在一个模块中写上：

Public Sub synchronizeLinkedCells(r As Range, rname As String)
   Dim nm As Name, p As Integer
   
   On Error Resume Next
   Application.EnableEvents = False
   For Each nm In ThisWorkbook.Names
       If InStr(1, nm.Name, rname) > 0 Then
           Range(nm.Name).Value = r.Value
       End If
   Next nm
Lerr:
   On Error GoTo 0
   Application.EnableEvents = True
End Sub

通过这种方式，您可以轻松地组织可能属于不同工作表的连接单元格组，轻松地添加和修改组...在示例中，将"LINK1"视为组ID，将"LINK1.1"...."LINK1.n"视为任何工作表中的组成员。

请尝试下一种方法。大部分功劳应该归于@Tim威廉姆斯，他使用Workbook_SheetChange事件的绝妙想法。代码使用了一个锯齿状数组（就像他的代码一样），但是每个数组都通过元素位置彼此同步。我只改编了他的代码：

Option Explicit

    
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
    Dim arrGroups, tgt As String, m, n, arr
    
    'arrays (of jagged array) are syicronzed as first witht first, second with second and so on:
    'Sheet1("D3") sync with Sheet2("F3"), Sheet2("B4") sync with Sheet3("F7"), Sheet3("C5") sync with Sheet1("D4")
    arrGroups = Array(Array("Sheet1|D3", "Sheet2|B4", "Sheet3|C5"), Array("Sheet2|F3", "Sheet3|F7", "Sheet1|D4")) 'use here what you need syncing
                     
    
    tgt = Sh.Name & "|" & Target.Address(False, False)
    
    'check to see in which array of the jagged array a match exists, if any:
    m = Application.Match(tgt, arrGroups(0), 0)
    n = Application.Match(tgt, arrGroups(1), 0)
    
    On Error GoTo bm_Safe_Exit
    If Not IsError(m) Then
        Application.EnableEvents = False
          arr = Split(arrGroups(1)(m - 1), "|")
          ThisWorkbook.Sheets(arr(0)).Range(arr(1)).Value = Target.Value
    ElseIf Not IsError(n) Then
        Application.EnableEvents = False
          arr = Split(arrGroups(0)(n - 1), "|")
          ThisWorkbook.Sheets(arr(0)).Range(arr(1)).Value = Target.Value
    End If
    
bm_Safe_Exit:
    Application.EnableEvents = True
End Sub

是否尝试过创建单元更新触发器？https://learn.microsoft.com/en-us/office/troubleshoot/excel/run-macro-cells-change
您可以单独触发一个单元格来更新另一个单元格。