Sub Реестр()
    Dim i%, Sh
    Cells.Clear 'Очистим лист Реестр
    i = 1
    For Each Sh In Sheets 'Перебираем все имеющиеся листы в Книге
        If Sh.Name <> "Реестр" Then 'пропустим лист Реестр
            i = i + 1
            With Sh
                Cells(i, 1) = .Range("A48") & " " & .Range("A49") & " № " & .Range("B51") & " " & .Range("T82") & " " & .Range("A83") 'Собираем текст из ячеек
                Cells(i, 2) = .Range("U51") & " " & .Range("X51") & " " & .Range("AC51") 'Собираем текст из ячеек
            End With
        End If
    Next Sh
End Sub

Sub Реестр()
    Dim i%, Sh, bSh As Boolean, Arr(1 To 100, 1 To 2)
    
    i = 0: bSh = False
    For Each Sh In Sheets 'Перебираем все имеющиеся листы в Книге
        If Sh.Name <> "Реестр" Then
            i = i + 1
            With Sh
                Arr(i, 1) = .Range("A48") & " " & .Range("A49") & " № " & .Range("B51") & " " & .Range("T82") & " " & .Range("A83")
                Arr(i, 2) = DateValue(.Range("U51") & " " & .Range("X51") & " " & Mid(.Range("AC51"), 1, 4))
            End With
        Else
            bSh = True
        End If
    Next Sh
    
    If Not bSh Then Set ShR = Sheets.Add: ShR.Name = "Реестр"
    With Sheets("Реестр")
        .Cells.Clear
        .Range("A1:B100") = Arr
        .Columns("A:B").EntireColumn.AutoFit
    End With
End Sub

Sub Реестр()
    Dim i%, Sh As Worksheet, rSh As Worksheet
    Application.ScreenUpdating = False
    On Error Resume Next
    Set rSh = Sheets("Реестр")
    If Err Then
        Err.Clear
        Set rSh = Sheets.Add
        rSh.Name = "Реестр"
    Else
        With rSh
            .Activate
            .UsedRange.Clear 'Очистим лист Реестр
        End With
    End If
    i = 1
    For Each Sh In Sheets 'Перебираем все имеющиеся листы в Книге
        If Sh.Name <> "Реестр" Then
            i = i + 1
            With Sh
                Cells(i, 1) = .Range("A48") & " " & .Range("A49") & " № " & .Range("B51") & " " & .Range("T82") & " " & .Range("A83")
                Cells(i, 2) = DateValue(.Range("U51") & " " & .Range("X51") & " " & Mid(.Range("AC51"), 1, 4))
            End With
        End If
    Next Sh
    rSh.Columns("A:B").AutoFit
    Application.ScreenUpdating = True
End Sub