Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Перебор диапазона с присваиванием новым листам имена из ячеек диапазона, макрос работает с последней строки, а нужно с первой, уже голову сломал
 
#1
17.09.2020 15:31:33
Добрый всем день.
Написал макрос, необходимо при его активации, чтобы создавался новый лист и название присваивалось из диапазона, а при уже имеющемся названии листа, использовалась следующая строка диапазона и так до бесконечности.
Я сломал всю голову но у меня название страниц идет с последней ячейки а не с первой, прошу указать где я накосячил.
Код
 
Sub добавить_вкладку_обновить_итог()
Dim rg As Range
Set rg = Worksheets("формулы").Range("H2").CurrentRegion
    Sheets("шаблон").Copy After:=Sheets(Sheets.Count)
  On Error Resume Next
    ActiveSheet.Name = Worksheets("формулы").rg.Cells(1, 1)
    Range("I3").Value = Worksheets("формулы").rg.Cells(1, 1)
    
    If Err.Number <> 0 Then
Dim i As Long

    For i = 1 To rg.Rows.Count
    
        ActiveSheet.Name = rg.Cells(i, 1).Value
        Range("I3").Value = ActiveSheet.Name
      
       Next i
     End If
      On Error GoTo 0
End Sub
Изменено: Sweeft1 - 17.09.2020 15:47:54
 
 
 
#2
17.09.2020 16:18:52
Sweeft1, доброго времени суток, так?
Код
Sub добавить_вкладку_обновить_итог()
Dim rg As Range
Set rg = Worksheets("формулы").Range("H2").CurrentRegion
On Error Resume Next
ActiveSheet.Name = Worksheets("формулы").rg.Cells(1, 1)
Range("I3").Value = Worksheets("формулы").rg.Cells(1, 1)
If Err.Number <> 0 Then
Dim i As Long
    For i = 1 To rg.Rows.Count
    k = 0
        For Each sh In Worksheets
            If sh.Name = rg.Cells(i, 1).Value Then k = k + 1
        Next sh
        If k = 0 Then
            Sheets("шаблон").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = rg.Cells(i, 1).Value
            Range("I3").Value = ActiveSheet.Name
        End If
    Next i
    End If
On Error GoTo 0
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#3
17.09.2020 16:59:34
Не совсем, вкладки добавились в нужном порядке, но все сразу, а нужно именно чтобы человек получал одну вкладку после одного нажатия.
Плюс добавилась вкладка шаблон(2) которой вообще не должно быть.
 
 
 
#4
17.09.2020 17:06:27
Цитата
Sweeft1 написал:
Плюс добавилась вкладка шаблон(2) которой вообще не должно быть.
у меня нет никакого лишнего листа...
Код
Sub добавить_вкладку_обновить_итог()
Dim rg As Range
Set rg = Worksheets("формулы").Range("H2").CurrentRegion
On Error Resume Next
ActiveSheet.Name = Worksheets("формулы").rg.Cells(1, 1)
Range("I3").Value = Worksheets("формулы").rg.Cells(1, 1)
If Err.Number <> 0 Then
Dim i As Long
    For i = 1 To rg.Rows.Count
    k = 0
        For Each sh In Worksheets
            If sh.Name = rg.Cells(i, 1).Value Then k = k + 1
        Next sh
        If k = 0 Then
            Sheets("шаблон").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = rg.Cells(i, 1).Value
            Range("I3").Value = ActiveSheet.Name
            Exit Sub
        End If
    Next i
    End If
On Error GoTo 0
End Sub
Не бойтесь совершенства. Вам его не достичь.
 
 
 
#5
17.09.2020 17:53:00
Уау..все заработало, спасибо
 
 
 
Страницы: 1
Наверх