Sub svod()
    Application.ScreenUpdating = False
    Dim data As Worksheet, list As Worksheet
    Set data = ThisWorkbook.Sheets("Данные")
    Set list = ThisWorkbook.Sheets("Список")
    With list
        .[a1].CurrentRegion.Offset(2).ClearContents
    End With
    With data
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        j = 3
        For Each col In Array(33, 46) '("ag", "at")
            For i = 4 To lr
                list.Cells(j, 2) = .Cells(i, col)
                list.Cells(j, 3) = .Cells(i, "l")
                list.Cells(j, 4) = .Cells(i, "p")
                list.Cells(j, 5) = .Cells(i, "q")
                list.Cells(j, 7) = .Cells(i, col - 1)
                j = j + 1
            Next i
        Next col
    End With
    With list
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=.[g3].Resize(j - 3) _
            , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange list.[a3].Resize(j - 3, 7)
            .Header = xlGuess: .Apply
        End With
    End With
End Sub