Как хранить записи из формы Excel в разные строки с помощью VBA?

Создайте массив из формы и выгрузите массив в InvoiceDatabase.

Sub Submit_Invoice()

    Dim lr As Long, ws As Worksheet
    dim arr as variant, i as long

    with Worksheets("Invoice Form")
        lr = .cells(16, "C").end(xlup).row - 8
        redim arr(1 to lr, 1 to 6)
        for i=lbound(arr,1) to ubound(arr, 1)
            arr(i, 1) = .cells(5, "D").value
            arr(i, 2) = .cells(6, "D").value
            arr(i, 3) = .cells(i+8, "C").value
            arr(i, 4) = .cells(i+8, "D").value
            arr(i, 5) = .cells(i+8, "E").value
            arr(i, 6) = .cells(i+8, "F").value
        next i
    end with

    WITH WORKSheets("InvoiceDatabase")
        lr = .Range("I" & .Rows.Count).End(xlUp).Row + 1
        .cells(lr, "I").resize(ubound(arr, 1), ubound(arr, 2)) = arr
    end with

 End Sub

Для этого вам действительно следует использовать базу данных формы / доступа или форму данных Excel (2016).

Тем не менее, ваш код перезаписывает каждую строку при записи на другой лист, поскольку она не увеличивается. Кроме того, вам не хватает того, как добавлять даты и номера счетов.

Далее используются более значимые имена и добавляются отсутствующие данные, а также некоторые основные проверки ошибок (например, есть данные для передачи) и служебные операции с точки зрения очистки формы после передачи.

Option Explicit
Public Sub Submit_Invoice()
    Dim nextRowDest As Long, lastRowSource As Long, wsDest As Worksheet, wsSource As Worksheet, transferData As Range
    Dim invoiceInfo As Range
    Application.ScreenUpdating = False

    Set wsDest = ThisWorkbook.Worksheets("InvoiceDatabase")
    Set wsSource = Workbooks("Invoice_Form.xlsm").Worksheets("Invoice Form")

    With wsSource
        lastRowSource = wsSource.Range("C" & .Rows.Count).End(xlUp).Row
        If lastRowSource < 9 Then Exit Sub       '<==No data
        Set transferData = .Range("C9:G" & lastRowSource)
        Set invoiceInfo = .Range("D5:D6")
    End With

    With wsDest
        nextRowDest = wsDest.Range("I" & Rows.Count).End(xlUp).Row + 1
        If nextRowDest < 4 Then Exit Sub         '<==Assume headers are in row 3
        transferData.Copy .Range("K" & nextRowDest)
        invoiceInfo.Copy
        .Range("I" & nextRowDest).Resize(transferData.Rows.Count, invoiceInfo.Rows.Count).PasteSpecial Transpose:=True
    End With

    transferData.ClearContents
    invoiceInfo.ClearContents

    Application.ScreenUpdating = True

End Sub