Bom dia, fiz um video para explicar melhor...
https://skydrive.live.com/redir?resid=3 ... -9wV_NsP2U

Grato mais uma vez...

Veja no anexo

Só vai até 2 a auto-numeração.
mas ideia é essa.

Opss!!!
Use o código abaixo:

Sub Inserir()
Dim nLin As Integer
nLin = Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1 '41
Range("B35:S35").Copy
Range("B" & nLin).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
If Range("A" & nLin - 1).Value > 1 Then
    Range("A" & nLin) = Range("A" & nLin - 1).Value + 1
Else
    Range("A" & nLin) = 1
End If

Range("B5:D19,B21:C35").ClearContents
End Sub

Perfeito!!!

Creio que ainda tem um erro, (como sempre a pressa ....)quando inicia a inclusão (primeira) deve retornar erro. Teste
Creio tambem que o abaixo atende:

Sub Inserir()
Dim nLin As Integer
nLin = Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1 '41
Range("B35:S35").Copy
Range("B" & nLin).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
If Range("A" & nLin - 1).Value > 1 And Range("A" & nLin - 1).Value = "cod" Then
    Range("A" & nLin) = 1
Else
    Range("A" & nLin) = Range("A" & nLin - 1).Value + 1
End If

Range("B5:D19,B21:C35").ClearContents
End Sub