Переименовывание листов, ввиду данных, находящихся в определенной ячейке листов

[VladimirTavr]

Добрый день!
Задача заключается в том, что нужно переименовать все листы, взяв информацию из ячейки "А2" на каждом листе. Причем в названии должны указываться буквы "ММ" с цифрой и первое слово.

[Дмитрий Щербаков(The_Prist)]

Код поместить в стандартный модуль и запустить:

Код (vb) Выделить Развернуть

Option Explicit

Sub RenameWS()
   Dim ws As Worksheet
   Dim s$, asp
   For Each ws In ActiveWorkbook.Worksheets
       s = ws.Range("A2").Value
       'убедились, что в ячейке больше 4 символов
       If Len(s) >= 4 Then
           asp = Split(s, " ")
           s = asp(0)
           If UBound(asp) > 1 Then
                s = s & " " & asp(1) & " " & asp(2)
            End If
           'пробуем переименовать лист и делаем пропуск ошибок,
           'если вдруг имя листа повторяется или содержит недопустимые символы
           On Error Resume Next
           ws.Name = s
           s = ""
           On Error GoTo 0
       End If
   Next
End Sub