Option Explicit
Option Base 1

Sub Test1()
    Dim WSh1 As Worksheet, WSh2 As Worksheet, Rng As Range
    Dim T1(), T2(), Arr(5), Blocks As New Collection, Item, Key As String
    Dim N As Long, L As Long, J1 As Long, J As Long, K As Long
    '=======
    Set WSh1 = Sheets("многоблочная")
    Set WSh2 = Sheets("Лист3")
    '=======
    T1 = WSh1.Range("Таблица1").Value
    On Error Resume Next
    For L = 1 To UBound(T1)
        If Len(T1(L, 1)) Then
            For J1 = 1 To 5
                For K = 1 To 4
                    J = (J1 - 1) * 4 + K
                    Arr(K) = T1(L, J)
                Next K
                Key = Arr(1) * 10000 + Arr(2)
                Arr(5) = Key
                Blocks.Add Arr, Key
                If Err Then Err.Clear
            Next J1
        End If
    Next L
    On Error GoTo 0
    ReDim T2(Blocks.Count, 5)
    L = 0
    For Each Item In Blocks
        L = L + 1
        For J = 1 To 5
            T2(L, J) = Item(J)
        Next
    Next
    Application.ScreenUpdating = False
    With WSh2
        .Range("A1").CurrentRegion.ClearContents
        .Range("A1:D1").Value = Array("Номер участка", "Номер точки", "X", "Y")
        Set Rng = .Range("A2:E2").Resize(L)
        Rng.Value = T2
        With .Sort
            .SortFields.Clear
            .SetRange Rng
            .SortFields.Add Rng.Columns(5)
            .Apply
        End With
        Rng.Columns(5).ClearContents
    End With
    Application.ScreenUpdating = True
End Sub

Function ЕдиныйФормат(Дата)
    Dim M As String, D As String
    If IsDate(Дата) Then
        M = Month(Дата): D = Day(Дата)
        ЕдиныйФормат = Year(Дата) & IIf(Len(M) = 1, 0 & M, M) & IIf(Len(D) = 1, 0 & D, D)
    Else
        ЕдиныйФормат = CVErr(xlErrValue)
    End If
End Function

Function ЕдиныйФормат2(Дата)
    If IsDate(Дата) Then ЕдиныйФормат2 = Format(Дата, "YYYYMMDD") Else ЕдиныйФормат2 = CVErr(xlErrValue)
End Function

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim objAxis As Axis
    '
    Set objAxis = Charts("Диаграмма1").Axes(xlCategory)
    If Not Intersect(Target, Range("B14")) Is Nothing Then
        objAxis.MinimumScale = Range("B14").Value
    End If
    If Not Intersect(Target, Range("B16")) Is Nothing Then
        objAxis.MaximumScale = Range("B16").Value
    End If
End Sub