Страницы: 1
RSS
Создание листа с название из ячейки
 
Здравствуйте, дорогие форумчане я хотел попросить о помощи с одним макросом. У Вас на форуме я нашел макрос, который почти подходит под решение моей проблемы, вот ссылка: http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=64086&TITLE_SEO=64086-kopirovanie-lista-iz-shablona-s-nazvaniem-po-nomeru-po-poryadku#postform. Это макрос копирует определенный лист и дает им названия по столбцу A:A, а мне нужно чтобы он делал тоже самое, только для выбранной мной ячейкой, она может быть любая в столбце A:A, т.е при запуске макроса будет создаваться один лист с названием из активной ячейки. Вот код
Код
Sub ListNomer()
Dim i As Long
Dim iLastRow As Long
    iLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 3 To iLastRow
      If Cells(i, 1).MergeCells Then
        Worksheets("Шаблон").Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Cells(i, 1)
        ActiveSheet.Range("B2").FormulaLocal = "=Номер!$A$"& i
            i = i + Cells(i, 1).MergeArea.Count - 1
      Else
        Worksheets("Шаблон").Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Cells(i, 1)
      End If
    Next
End Sub
 
Код
Sub NewSheetFromCell()
Dim ac As Range
On Error Resume Next
Set ac = ActiveCell
Worksheets("Шаблон").Copy After:=Worksheets(Worksheets.Count)
If Err Then MsgBox "Скопировать лист не удалось", vbCritical: Exit Sub
ActiveSheet.Name = ac
If Err Then MsgBox "Переименовать лист не удалось", vbCritical: Exit Sub
ac.Worksheet.Activate
End Sub
 
Я хотел уточнить а вот эту строчку куда вставить
Код
ActiveSheet.Range("B2").FormulaLocal = "=Номер!$A$"& i
она переносит формулу на ячейку с которой создавался лист
 
Код
Sub NewSheetFromCell()
Dim ac As Range
On Error Resume Next
Set ac = ActiveCell
Worksheets("Шаблон").Copy After:=Worksheets(Worksheets.Count)
If Err Then MsgBox "Скопировать лист не удалось", vbCritical: Exit Sub
ActiveSheet.Name = ac
ActiveSheet.Range("B2").FormulaLocal = "=" & ac.Address(external:=True)
If Err Then MsgBox "Переименовать лист не удалось", vbCritical: Exit Sub
ac.Worksheet.Activate
End Sub
 
Извиняете, что не сразу написал но вот эта строчка при копирование листа переносит не только эту формулу, но и другие например
Код
        ActiveSheet.Range("K8").FormulaLocal = "=Шаблон!B" & i
        ActiveSheet.Range("E10").FormulaLocal = "=Шаблон!AA" & i + 1
        ActiveSheet.Range("Q146").FormulaLocal = "=Шаблон!AA" & i
        ActiveSheet.Range("L10").FormulaLocal = "=Шаблон!D" & i
        ActiveSheet.Range("E12").FormulaLocal = "=Шаблон!BW" & i
        ActiveSheet.Range("D15").FormulaLocal = "=Шаблон!E" & i
и не только, формулы будут дополняться. Я просто думал что подставлю это в ваш макрос, а оказалось не так все просто, как мне быть подскажите?
 
Если i - номер строки ячейки, то добавьте перед этим
Код
i = ac.Row
 
Я сделал так, но он на созданном листе в тех ячейках куда должны были перенестись формулы пишет "ЛОЖЬ" и формулы не перенес, может что то не так сделал. Вот пример:
 
ИЗВИНЯЮСЬ ВОТ ПРИМЕР!!!!
 
Цитата
Delux написал: Я сделал так
Я имел в виду
Код
i = ac.Row
ActiveSheet.Range("K8").FormulaLocal = "=Шаблон!B" & i
        ActiveSheet.Range("E10").FormulaLocal = "=Шаблон!AA" & i
        ActiveSheet.Range("Q146").FormulaLocal = "=Шаблон!AA" & i
        ActiveSheet.Range("L10").FormulaLocal = "=Шаблон!D" & i
        ActiveSheet.Range("E12").FormulaLocal = "=Шаблон!BW" & i
        ActiveSheet.Range("D15").FormulaLocal = "=Шаблон!E" & i
Но, судя по файлу, тут нужно что-то другое. Объясните словами, куда что должно переноситься после создания листа.
 
В последнем примере на листе "Шаблон" имеется код
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target = Range("B1") Then
        If Target.Value <> "" Then
            If Len(Target.Value) < 30 Then
                Target.Parent.Name = Target.Value
            End If
        End If
    End If
End Sub
 
Всё разобрался. Вы всё правильно сделали, спасибо Вам большое за то что помогли, огромнейшее человеческое спасибо, выручили!!!!!!!!
Страницы: 1
Наверх