Inserir linha(s) com duplo clique

‘—————————————————————————————
‘ Procedure : Worksheet_BeforeDoubleClick
‘ DateTime : 17-04-2017 23:55
‘ Author : Jorge Rodrigues
‘ Purpose : Duplo clique para indicar o número de linhas a inserir abaixo da célula activa
‘ : Mantém a formatação da linha a copiar, limpando os dados
‘ : Desprotege Worksheet e volta a protegê-la
‘—————————————————————————————
‘
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim rInsere As Integer
Dim rNum As Integer

rInsere = InputBox(Prompt:=”Digite o número de linhas a inserir”)

Sheets(“PROG”).Unprotect Password:=”kkkk”
For rNum = 1 To rInsere

ActiveCell.Offset(1, 0).EntireRow.Insert
ActiveCell.EntireRow.Copy ActiveCell.Offset(1, 0).EntireRow
ActiveCell.Offset(1, 0).EntireRow.SpecialCells(xlCellTypeConstants).ClearContents

Next rNum

Cancel = True

Sheets(“PROG”).Protect Password:=”kkkk”
End Sub