Pasar datos de un formulario a otro libro de excel

Necesito ayuda para refinar una parte de mi código que no consigo lo mande a las celdas deseadas.

La parte donde tengo el problema es en los listbox.

Gracias

 Private Sub Imprimirparte()
Dim objExcel As Application
Dim RutaArchivo As String
Dim Texto As String
Dim Fila As Integer
Set objExcel = CreateObject("Excel.Application")
With objExcel
    RutaArchivo = ThisWorkbook.Path & "\parte_tmp.xlsx"
    If IsFileOpen(RutaArchivo) Then
            MsgBox "El libro debe estar cerrado para proceder."
            Exit Sub
    Else
        '
        With .Workbooks.Open(RutaArchivo)
       .Worksheets("Hoja1").Range("parte").ClearContents
        Fila = 18
        Do While .Worksheets("Hoja1").Cells(18, 1) <> ""
            Fila = Fila + 1
        Loop
final = Fila
                .Worksheets("Hoja1").Range("D2").Value = Me.cbo_not
                .Worksheets("Hoja1").Range("C3").Value = Me.txt_descrip
                .Worksheets("Hoja1").Range("G2").Value = Me.txt_fecha
                .Worksheets("Hoja1").Range("B8").Value = Me.eje1
                .Worksheets("Hoja1").Range("B10").Value = Me.eje2
                .Worksheets("Hoja1").Range("B12").Value = Me.eje3
            For i = 0 To Me.ListBox1.ListCount - 1
                .Worksheets("Hoja1").Cells(final, 1) = Me.ListBox1.List(i, 0) ' se tiene que grabar en la celda A18
                .Worksheets("Hoja1").Cells(final, 2) = Me.ListBox1.List(i, 1) ' se tiene que grabar en la celda D18
                .Worksheets("Hoja1").Cells(final, 3) = Me.ListBox1.List(i, 2) ' se tiene que grabar en la celda F18
                final = final + 1
            Next
             For J = 0 To Me.ListBox2.ListCount - 1
                .Worksheets("Hoja1").Cells(final, 1) = Me.ListBox2.List(i, 0) ' se tiene que grabar en la celda N42
                .Worksheets("Hoja1").Cells(final, 2) = Me.ListBox2.List(i, 1) ' se tiene que grabar en la celda P42
                final = final + 1
            Next
'Establecer área de impresión y enviar al impresor.
.Worksheets("Hoja1").PageSetup.PrintArea = "parte"
.Worksheets("Hoja1").PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
                .Close SaveChanges:=True
            End With
        End If
    .Quit
End With
End Sub