Repetir el trabajo en las dos líneas

Te anexo la macro actualizada

Sub Macro3()
'
' Macro3 Macro
'
' Acceso directo: CTRL+q
'
If Range("a2").Value = "" Then
      res = MsgBox("No existe fecha : " & hoja & vbCr & _
                     " Quieres darla de alta", vbQuestion + vbYesNo, "")
      If res = vbNo Then
      Exit Sub
       End If
       If res = vbYes Then
       Exit Sub
        Range("a2").Select
        ActiveCell.Offset(0, 0).Select
      End If
End If
ActiveSheet.Range("$A$5:$E$13").AutoFilter Field:=1
ActiveSheet.Range("$A$5:$E$13").AutoFilter Field:=2
ActiveSheet.Range("$A$5:$E$13").AutoFilter Field:=3
ActiveSheet.Range("$A$5:$E$13").AutoFilter Field:=4
ActiveSheet.Range("$A$5:$E$13").AutoFilter Field:=5
Range("b2").Select
If ActiveCell.Offset(1, 0).Value = "" Then
  Range("b2").Copy
   Range("b3").Select
   ActiveCell.PasteSpecial xlValues
   Application.CutCopyMode = False
 End If
   Call macro6
    'Act.Por.Dante Amor
    Set h1 = Sheets("LIBRO DIARIO")
    hoja = Sheets("LIBRO DIARIO").[C2].Value
    existe = False
    For Each h In Sheets
        If LCase(h.Name) = LCase(hoja) Then
            existe = True
            Exit For
        End If
    Next
    If existe = False Then
        res = MsgBox("No existe la hoja : " & hoja & vbCr & _
                     " Quieres darla de alta", vbQuestion + vbYesNo, "ALTA HOJA")
        If res = vbNo Then Exit Sub
        Sheets("formato").Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = hoja
    End If
    '
    Application.Goto Sheets(Sheets("LIBRO DIARIO").[C2].Text).[C2]
    Range("A2").Select
    On Error Resume Next
    ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Select
     'AcA COPIE LA PARTE NUEVA  ----------------
    h1.Range("A2:E2").Copy
    ActiveCell.PasteSpecial xlValues
    ActiveCell.PasteSpecial Paste:=xlPasteColumnWidths
    Application.CutCopyMode = False
    'ActiveCell.Offset(1, 0).Select
    'ActiveCell.EntireRow.Insert
    '
    '--------- Actualiza balance
    If existe = False Then
        Set h2 = Sheets("BALANCE")
        u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
        h2.Range("A" & u) = "=" & hoja & "!C3"
        h2.Range("B" & u) = "=" & hoja & "!F2"
    End If
    'Para la cuenta DOS
    hoja = Sheets("LIBRO DIARIO").[C3].Value
    existe = False
    For Each h In Sheets
        If LCase(h.Name) = LCase(hoja) Then
            existe = True
            Exit For
        End If
    Next
    If existe = False Then
        res = MsgBox("No existe la hoja : " & hoja & vbCr & _
                     " Quieres darla de alta", vbQuestion + vbYesNo, "ALTA HOJA")
        If res = vbNo Then Exit Sub
        Sheets("formato").Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = hoja
    End If
    '
    Application.Goto Sheets(Sheets("LIBRO DIARIO").[C3].Text).[C3]
    Range("A2").Select
    On Error Resume Next
    ActiveSheet.Range("A1").End(xlDown).Offset(1, 0).Select
     'AcA COPIE LA PARTE NUEVA  ----------------
    h1.Range("A3:E3").Copy
    ActiveCell.PasteSpecial xlValues
    ActiveCell.PasteSpecial Paste:=xlPasteColumnWidths
    Application.CutCopyMode = False
    'ActiveCell.Offset(1, 0).Select
    'ActiveCell.EntireRow.Insert
    '
    '--------- Actualiza balance
    If existe = False Then
        Set h2 = Sheets("BALANCE")
        u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
        h2.Range("A" & u) = "=" & hoja & "!C3"
        h2.Range("B" & u) = "=" & hoja & "!F2"
    End If
    '-----------  ACA  REGRESA AL LIBRO --------------------------
    Sheets("libro diario").Select
    Range("A2").Select
    Range("A2:E2"). ClearContents
    Range("B3:C3"). ClearContents
End Sub

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias