Sub SheetRename()
For s = 1 To Worksheets.Count
Worksheets(s).Activate
On Error GoTo newname
ActiveSheet.Name = Range("A1")
newname:
ActiveSheet.Name = Range("A1") & s
Next s
End Sub
Переименование листов книги Excel
Добрый день! Помогите решить проблему!
Имеется книга Excel с N кол-вом листов. Нужно в VBA переименовать листы по значению ячейки "A1". Нужна процедура которая бы выполныла следующее:
1. Активировать первый лист
2. Переименовать лист по значению в ячейке ("A1" = ABC) в ABC. Если это первое имя листа то прибавить к нему 1. ABC (1)
3. Следующие листы с таким же значением ячейки должен иметь имя ABC (2), ABC (3) ... и т.д.
4. Если значение ячейки другое (новое) ("A1" =DEF ), тогда имя листа должно быть DEF (1), а следующие DEF (2), DEF (3)... и т.д.
Так как я новичок в VBA програмировании то прошу написать работающий код.
Вот что я смог написать, но к сожалении при новом значении ячейки порядковый номер продолжает увеличиваться
Пример:
ABC (1), ABC (2), ABC (3), DEF (4), DEF (5), DEF (6), GHI (7), GHI (8), GHI (9).
А необходимо
Пример:
ABC (1), ABC (2), ABC (3), DEF (1), DEF (2), DEF (3), GHI (1), GHI (2), GHI (3).
Имеется книга Excel с N кол-вом листов. Нужно в VBA переименовать листы по значению ячейки "A1". Нужна процедура которая бы выполныла следующее:
1. Активировать первый лист
2. Переименовать лист по значению в ячейке ("A1" = ABC) в ABC. Если это первое имя листа то прибавить к нему 1. ABC (1)
3. Следующие листы с таким же значением ячейки должен иметь имя ABC (2), ABC (3) ... и т.д.
4. Если значение ячейки другое (новое) ("A1" =DEF ), тогда имя листа должно быть DEF (1), а следующие DEF (2), DEF (3)... и т.д.
Так как я новичок в VBA програмировании то прошу написать работающий код.
Вот что я смог написать, но к сожалении при новом значении ячейки порядковый номер продолжает увеличиваться
Пример:
ABC (1), ABC (2), ABC (3), DEF (4), DEF (5), DEF (6), GHI (7), GHI (8), GHI (9).
А необходимо
Пример:
ABC (1), ABC (2), ABC (3), DEF (1), DEF (2), DEF (3), GHI (1), GHI (2), GHI (3).
Код:
Код:
Public Sub RenameSheets()
Dim i As Integer
For Each sh In Sheets
i = 0
With sh
On Error Resume Next
Do
Err.Clear
i = i + 1
.Name = .Range("A1") & " (" & CStr(i) & ")"
Loop While (Err.Number > 0)
End With
Next
End Sub
Dim i As Integer
For Each sh In Sheets
i = 0
With sh
On Error Resume Next
Do
Err.Clear
i = i + 1
.Name = .Range("A1") & " (" & CStr(i) & ")"
Loop While (Err.Number > 0)
End With
Next
End Sub