=ФИЛЬТР.XML("<l><i>"&ОБЪЕДИНИТЬ("</i><i>";1;Лист2!B2:E10)&"</i></l>";"//i[contains(., '.')]")

=ФИЛЬТР.XML("<j>"&СЦЕП("<i>"&Лист2!B2:E10&"</i>")&"</j>";"//i[contains(., '.')]")

=ФИЛЬТР.XML("<l><i>"&ОБЪЕДИНИТЬ("</i><i>";1;ТРАНСП(Лист2!B2:E10))&"</i></l>";"//i[contains(., '.')]")

=ФИЛЬТР.XML("<j>"&СЦЕП("<i>"&ТРАНСП(Лист2!B2:E10)&"</i>")&"</j>";"//i[contains(., '.')]")

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    ConnectSheets "Лист1", "Лист2"
End Sub

Sub ConnectSheets(targetName As String, sourceName As String)
    Dim sht As Worksheet: Set sht = Sheets(targetName)
    Dim shs As Worksheet: Set shs = Sheets(sourceName)
    
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim cs As Range, cs_Value As String
    For Each cs In shs.UsedRange.Cells
        cs_Value = cs.Value
        If InStr(cs_Value, ".") > 0 Then
            If Not cs_Value Like "#." Then
                If Not dic.Exists(cs_Value) Then
                    dic.Add cs_Value, "='" & sourceName & "'!" & cs.Address(0, 0, xlA1)
                End If
            End If
        End If
    Next
    Dim arr As Variant
    arr = RedimArr(dic.Items())
    
    PrintArray arr, sht.Cells(2, 1)
End Sub

Private Sub PrintArray(arr As Variant, cl As Range)
    cl.Cells(2, 1).Resize(cl.Parent.UsedRange.Rows.Count).Clear
    If IsEmpty(arr) Then Exit Sub
    
    If UBound(arr, 1) > 1 Then
        cl.Copy cl.Resize(UBound(arr, 1), UBound(arr, 2))
    End If
    cl.Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub

Private Function RedimArr(arr As Variant) As Variant
    If LBound(arr) > UBound(arr) Then Exit Function
    Dim brr As Variant, ya As Long, yb As Long
    ReDim brr(1 To UBound(arr) - LBound(arr) + 1, 1 To 1)
    yb = LBound(brr, 1) - 1
    For ya = LBound(arr) To UBound(arr)
        yb = yb + 1
        brr(yb, 1) = arr(ya)
    Next
    RedimArr = brr
End Function