VBA COPIAR COM CRITÉRIOS E COLAR EM OUTRA PLANILHA

[ANILTO DA SILVA MARTINS]

Pessoal, estou com dificuldade de ajustar um código VBA, para colar na linha em branco da segunda planilha (Orcamento), pois no codigo abaixo, está transpondo na mesma posição que estou copiando da primeira planilha (Precalculo). Poderiam me ajudar por favor...

Muito obrigado pela atenção.

Sub CopiarItensPrecalculo()

    On Error GoTo Sair
   
    'DIGITAR ITEM DA LINHA
    critério = PreCalculo.Cells(7, 26).Value
    
    Application.ScreenUpdating = False

    Dim i                   As Integer
    Dim Ult_linha           As Long
        
    'PLANILHA ORCAMENTO INICIA LINHA 15 A 35
     Ult_linha = 15
                
'PLANILHA PRECALCULO

 For i = 23 To 43
    
    If PreCalculo.Cells(i, 2).Value = critério Then
    
        'quant
        Orcamento.Cells(Ult_linha, 3).Value = PreCalculo.Cells(i, 4).Value
        'modelo
        Orcamento.Cells(Ult_linha, 5).Value = PreCalculo.Cells(i, 22).Value
        'referencia
        Orcamento.Cells(Ult_linha, 8).Value = PreCalculo.Cells(i, 11).Value
        'comprimento
        Orcamento.Cells(Ult_linha, 14).Value = PreCalculo.Cells(i, 47).Value
        'largura
        Orcamento.Cells(Ult_linha, 16).Value = PreCalculo.Cells(i, 50).Value
        'altura
        Orcamento.Cells(Ult_linha, 18).Value = PreCalculo.Cells(i, 53).Value
        'qualidade
        Orcamento.Cells(Ult_linha, 20).Value = PreCalculo.Cells(i, 38).Value
        'fechamento
        Orcamento.Cells(Ult_linha, 24).Value = PreCalculo.Cells(i, 74).Value
        'valor unit
        Orcamento.Cells(Ult_linha, 26).Value = PreCalculo.Cells(i, 69).Value

    End If
    
'ESTÁ COLANDO NA MESMA POSIÇÃO DO ITEM PRECALCULO
Ult_linha = Ult_linha + 1
Next

MsgBox "Processo concluído"
Sair:
   Application.ScreenUpdating = True

End Sub