Altere sua macro conforme abaixo

Sub Retângulo2_Clique()

Dim lRow As Long

lRow = ActiveSheet.Cells(Cells.Rows.Count, "S").End(xlUp).Row
Rows(lRow).Select
Selection.Copy
Rows(lRow + 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Range("B" & lRow + 1).Select
End Sub

Outra sugestão:

Sub Lin()
Dim i As Integer

i = Cells(Cells.Rows.Count, 19).End(xlUp).Row

    Range("B" & i & ":S" & i).AutoFill Range("B" & i & ":S" & i + 1)
    
End Sub

Qualquer coisa da o grito...

Preciso que ao inserir a linha, ela fique sem nenhum preenchimento, mas que a formula da coluna "S" seje copiada.

silva_jmp

Tenta assim:

Sub Lin()
Dim i As Integer

i = Cells(Cells.Rows.Count, 19).End(xlUp).Row

    Range("B" & i & ":S" & i).AutoFill Range("B" & i & ":S" & i + 1)
    Range("B" & i + 1 & ":R" & i + 1).ClearContents
            
End Sub

Uma dica:
Nas fórmulas nomeadas (Ctrl + F3), altere a fórmula da "Area_de_impressao" para essa:

=INDIRETO("'Programa Anual (2)'!$B$2:$P$"&CONT.VALORES('Programa Anual (2)'!$B$10:$B$500)+9)

Com essa fórmula ele já ajeita automático a área de impressão.

Qualquer coisa da o grito...

Minha versão...:

i = Range("B65536").End(xlUp).Row
j = i + 1

Range(i & ":" & i).Copy
Range(j & ":" & j).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("S" & i).Copy
Range("S" & j).Select
ActiveSheet.Paste

Application.CutCopyMode = False

Range("B" & j).Activate

Ops.. observando que está bem próxima da sugestão do Reinaldo, apenas com a ressalva do Copiar e Colar da coluna S, qua não pode ser apenas do Formato.

Reinaldo, Bernardo e Edson, é por essas e outras que amo o VBA, ele nos permite uma infinidade de opções para se chegar a um mesmo resultado, então segue minha sugestão :

Sub InsereLinha()
    Dim UltimaLinha As Long
    
        UltimaLinha = Range("B" & Rows.Count).End(xlUp).row
        
        Range("B" & UltimaLinha).EntireRow.Copy
        Range("B" & UltimaLinha + 1).EntireRow.Insert
        
        UltimaLinha = UltimaLinha + 1
        
        Range("B" & UltimaLinha & ":R" & UltimaLinha).ClearContents

End Sub

[]s

Pessoal,

Achei uma resposta super eficaz:

Sub InsereLinha()
Dim linha As Long

linha = Range("B" & Rows.Count).End(xlUp).Row
linha = linha + 1
Range("B" & linha).Select

With Selection.EntireRow
.Offset(-1).Copy
.Insert
On Error Resume Next
.Offset(-1).SpecialCells(xlCellTypeConstants, 23).ClearContents
On Error GoTo 0
End With

End Sub