Sub Переименовать_листы()
    
    Dim strFolder As String, strFileName As String
    Dim bk As Workbook, sh As Worksheet
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = 0 Then
            Exit Sub
        End If
        strFolder = .SelectedItems(1)
    End With
    
    Application.ScreenUpdating = False
    
    strFileName = Dir(strFolder & "\*.xls")
    Do While strFileName <> ""
        Set bk = Workbooks.Open(strFolder & "\" & strFileName)
        For Each sh In bk.Worksheets
            Select Case LCase(sh.Name)
                Case "почта"
                    sh.Name = "p"
                Case "банк"
                    sh.Name = "b"
            End Select
        Next
        bk.Close SaveChanges:=True
        strFileName = Dir
    Loop
    
    Application.ScreenUpdating = True
    
    MsgBox "Готово!", vbInformation
    
End Sub