Доработка VBA кода

[MaxxVer]

Добрый день, уважаемые форумчане! Прошу Вашей помощи в корректировке VBA кода. Во вложении формат для заполнения напичканный макросами (я в них абсолютный ноль), в котором запрограммирована очень неудобная для пользователя функция – при двойном клике мыши на синем названии статьи, добавляется новая строка - неудобно это тем, что добавляется только одна строка, а обычно их нужно довольно много. Прошу Вас скорректировать код так, чтобы при двойном клике открывалось маленькое окошко, в котором пользователь мог указать необходимое количество строк и при дальнейшем нажатии «ОК» добавлялось соответствующее количество строк (строки должны добавляться с тем же функционалом как в оригинале, т.е. приписываться автоматом код строки и №№, копироваться формулы).
Чтобы добраться до необходимого документа нужно: выбрать формат (например 7.1), выбрать период и компанию (любую), высветить свод.

[MaxxVer]

Чувствую попросил многого, тогда прошу хотя бы подсказать как найти в коде строку где прописано добавление новой строки по двойному щелчку на определенной ячейке. И как прописать возможность добавить необходимое (больше одной) количество строк по щелчку на той же ячейке.

Private Sub Worksheet_Activate()

'If ActiveWorkbook.Name = "invest_1.1.xls" And Workbooks("invest_1.1.xls").Sheets( "l0").Range("H4") = 0 And Workbooks("invest_1.1.xls").Sheets( "l0").Range("H3") = 0 Then
' Workbooks("invest_1.1.xls").Sheets( "l0").Range("H4") = 1
' UserForm12.Show
'End If

End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Cancel = True
If Cells(Target.Row, 5).Font.ColorIndex = 5 Then
If IsEmpty(Cells(Target.Row, 7)) Then
MsgBox "Ââåäèòå íàèìåíîâàíèå ïðîåêòà"
Exit Sub
End If
ActiveSheet.Unprotect
If Cells(Target.Row, 6) < 600 Then
Rows(Format(Target.Row + 35) + ":" + Format(Target.Row + 69)).Insert Shift:=xlDown
Range("E" + Format(Target.Row) + ":E" + Format(Target.Row + 34)).Copy
Range("E" + Format(Target.Row + 35)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("E" + Format(Target.Row) + ":O" + Format(Target.Row + 34)).Copy
Range("E" + Format(Target.Row + 35)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Cells(Target.Row + 35, 5) = "ÏÐÎÅÊÒ/ÐÀÇÄÅË ¹ " + Format(Val(Right(Cells(Target.Row, 5), 2)) + 1, "00")
Cells(Target.Row + 35, 6) = Val(Cells(Target.Row, 6)) + 10
Cells(Target.Row + 36, 6) = Val(Format(Cells(Target.Row + 35, 6)) + "00001")
Cells(Target.Row + 37, 6) = Val(Format(Cells(Target.Row + 35, 6)) + "00002")
Range("F" + Format(Target.Row + 36) + ":F" + Format(Target.Row + 37)).AutoFill Destination:=Range("F" + Format(Target.Row + 36) + ":F" + Format(Target.Row + 69))
Range("E" + Format(Target.Row)).Font.ColorIndex = 1
Range("G" + Format(Target.Row + 35)).Select
Else
Rows(Format(Target.Row + 23) + ":" + Format(Target.Row + 45)).Insert Shift:=xlDown
Range("E" + Format(Target.Row) + ":E" + Format(Target.Row + 22)).Copy
Range("E" + Format(Target.Row + 23)).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("E" + Format(Target.Row) + ":O" + Format(Target.Row + 22)).Copy
Range("E" + Format(Target.Row + 23)).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Cells(Target.Row + 23, 5) = "ÏÐÎÅÊÒ/ÐÀÇÄÅË ¹ " + Format(Val(Right(Cells(Target.Row, 5), 2)) + 1, "00")
Cells(Target.Row + 23, 6) = Val(Cells(Target.Row, 6)) + 10
Cells(Target.Row + 24, 6) = Val(Format(Cells(Target.Row + 23, 6)) + "00001")
Cells(Target.Row + 25, 6) = Val(Format(Cells(Target.Row + 23, 6)) + "00002")
Range("F" + Format(Target.Row + 24) + ":F" + Format(Target.Row + 25)).AutoFill Destination:=Range("F" + Format(Target.Row + 24) + ":F" + Format(Target.Row + 45))
Range("E" + Format(Target.Row)).Font.ColorIndex = 1
Range("G" + Format(Target.Row + 23)).Select
End If
ActiveSheet.Protect
End If

End Sub

'Private Sub Worksheet_Change(ByVal Target As Range)
'Dim c1 As Variant
'Dim c2 As Variant
'Dim i As Integer

'With ActiveSheet.Range("f:f")
' Set c1 = .Find("77777", LookIn:=xlValues, LookAt:=xlWhole)
'End With
'i = 6
'Do While Cells(11, i).Interior.Color <> 12632256
' i = i + 1
'Loop

'With Range(Cells(11, 7), Cells(c1.Row, i))
' Set c2 = .Find(":", LookIn:=xlValues, LookAt:=xlPart)
' If Not c2 Is Nothing Then
' MsgBox "Çàïðåùåíî ââîäèòü â òåêñòîâîì ïîëå ñëóæåáíûé ñèìâîë ':' (ñì.Èíñòðóêöèþ)"
' Cells(c2.Row, c2.Column).Select
' End If
'End With

'End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If (Target.Column = 8 Or Target.Column = 9 Or Target.Column = 10 Or Target.Column = 11) And Cells(Target.Row, Target.Column).Locked = False And Cells(Target.Row, 6) <> 55555 And Cells(Target.Row, 6) <> 77777 Then
'UserForm7.Show
End If
If ActiveWorkbook.Name <> "lst_invest.xls" And Target.Column = 7 And Cells(Target.Row, Target.Column).Locked = False And Cells(Target.Row, 6) <> 55555 And Cells(Target.Row, 6) <> 77777 Then
'namefile = "c:/out/etc/invest_pr_" + Sheets("l0").Range("B3").Value + ".txt"
namefile = Sheets("l0").Range("C10").Value + "/etc/invest_pr_" + Sheets("l0").Range("B3").Value + ".txt"
If Dir(namefile) = "" Then
'MsgBox "Íå íàéäåí ñïðàâî÷íèê ïðîåêòîâ"
Exit Sub
End If
UserForm13.Show
End If

End Sub

[alex77755]

Private Sub Worksheet_BeforeDoubleClick

[alex77755]

добавляется новая строка - неудобно это тем, что добавляется только одна строка, а обычно их нужно довольно много

вообще-то добавляется 35 строк

Rows(Format(Target.Row + 35) + ":" + Format(Target.Row + 69)).Insert Shift:=xlDown

[alex77755]

И ещё в зависимости от сдержания 6 ячейки выбоанной строки

If Cells(Target.Row, 6) < 600 Then

Вставляетя либо 35 либо 23 строки

[alex77755]

Добалять несколько блоков можно так(но только добавление, а там ещё есть копирование, вставка, назначение цвета и значений, автозаполнение. для того нужно разбираться, организовывать циклы)
Но это только для первого условия

Dim Ск As Byte
Ск = InputBox("сколько блоков вставлять", "", 1) - 1
Rows(Format(Target.Row + 35) + ":" + Format(Target.Row + 69 + Ск * 35)).Insert Shift:=xlDown

[MaxxVer]

Спасибо! Попробую поразбираться.