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
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
Я сделал так, но он на созданном листе в тех ячейках куда должны были перенестись формулы пишет "ЛОЖЬ" и формулы не перенес, может что то не так сделал. Вот пример:
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