Sub ls()
Dim dic, key As Variant, wb As Workbook, mass(), sh As Worksheet
Set dic = CreateObject("Scripting.Dictionary")
i = 2
Do While Cells(i, 2).Value <> ""
    V = dic.Item(Cells(i, 2).Value)
    i = i + 1
Loop
For Each key In dic.keys
    Set wb = Workbooks.Open(key)
    For Each sh In wb.Worksheets
        a = a + 1
        ReDim Preserve mass(1 To 5, 1 To a)
        mass(1, a) = sh.Name
        mass(2, a) = key
        mass(3, a) = key
        mass(4, a) = key
        mass(5, a) = key
    Next
wb.Close 0
Next
Range("A2").Resize(a, 2).Value = Application.Transpose(mass())
End Sub

наименование  муниципального района
Наименование  бюджетов муниципальных районов
Нименование  бюджетов муниципальных районов
Наименование  бюджета муниципального района

With book2
        For Each sh In .Worksheets
            If sh.Name = dicOb.Item(ikey) Then sh.Name = dicOb1.Item(ikey)
        Next sh
        .Close True
    End With

Public Sub www()
    Dim wb As Workbook, i&
    On Error Resume Next
    For i = 2 To 52
        If Cells(i, 2).Interior.ColorIndex = 6 Then
            Set wb = Workbooks.Open(Cells(i, 7).Value, False)
            wb.Sheets(Cells(i, 2).Value).Name Cells(i, 1).Value
            wb.Close -1: Set wb = Nothing
        End If
    Next
End Sub

Public Sub www()
    Dim wb As Workbook, i&
    On Error Resume Next
    For i = 2 To 52
        If Cells(i, 2).Interior.ColorIndex = 6 Then
            Set wb = Workbooks.Open(Cells(i, 7).Value, , False, , , , , , , True)
            For Each sh In wb.Worksheets
                sh(Cells(i, 2).Value).Name.Activate = Cells(i, 1).Value
            Next
            wb.Close 0
            End If
    Next
End Sub

Sub RS()
For i = 1 To Sheets.Count
If Worksheets(i).Range("A1").Value <> "" Then
Sheets(i).Name = Worksheets(i).Range("A1").Value
End If
Next
End Sub