Option Explicit

Sub Invoice_Save()
    
    Dim r As Long, i As Long, serv, qu
    
    With Sheet1
        If .Range("J4").Value = Empty Or .Range("I6").Value = Empty Then
            MsgBox "Please Make sure to enter and Invoice # and Date"
            Exit Sub
        End If
    End With
    
    With Sheet2
        With .UsedRange
           r = .Row + .Rows.Count   'Invoice Row
        End With
        .Range("A" & r).Value = Sheet1.Range("I6").Value 'Date
        .Range("B" & r).Value = Sheet1.Range("J4").Value 'InvNumb
        .Range("C" & r).Value = Sheet1.Range("I8").Value 'Customer
        .Range("D" & r).Value = Sheet1.Range("I10").Value 'Provider
        .Range("W" & r).Value = Sheet1.Range("I48").Value 'Notes
        
        ' Service and Quantity 1-9
        For i = 0 To 8
            serv = Sheet1.Range("I12").Offset(i * 4) 'Service i+1
            qu = Sheet1.Range("L14").Offset(i * 4) ' Quantity i+1
            If Len(serv) > 0 Or Len(qu) > 0 Then
               If i > 0 Then r = r + 1
               .Range("E" & r).Value = serv
               .Range("F" & r).Value = qu
            End If
        Next
    End With

End Sub

我在想，我应该提出一种方法，你可以干预一些变化，如果，例如，发票的某些字段的位置改变或增加一个字段，而不一定知道很多东西从编程。在简单的情况下，您只需要添加要匹配的字段。所以我做了另一个Sub在那里你有一个视觉匹配的字段。还有一个变量gapBetweenInvoices，您可以将记录之间差距行设置为值。我将其设置为1以获得更好的演示效果。

Sub Invoice_Save()
   Dim src As Range, dst As Range, r As Range, lastUsedCell As Range
   Dim srcCellsCnt As Long, freeRow As Long, c As Long, sv() As Variant, cnt As Long
   'MODIFY gapBetweenInvoices to have empty rows between records
   Const maxServices = 9, gapBetweenInvoices = 1   'gap one row
   
   ' This way there is a visual one-to-one mapping of the cells from the source sheet
   ' to the destination sheet. This way it will be easy to make any modification that may arise.
   ' CAN CHANGE THE FORMAT OR ADD MORE FIELDS... CHANGING ONLY THE NEXT TWO LINES OF CODE
   Set src = Sheet1.Range("I6, J4, I8, I10, I12, I16, I20, I24, I28, I32, I36, I40, I44, L14, L18, L22, L26, L30, L34, L38, L42, L46, L48")
   Set dst = Sheet2.Range("A1, B1, C1, D1,  E1,  E2,  E3,  E4,  E5,  E6,  E7,  E8,  E9,  F1,  F2,  F3,  F4,  F5,  F6,  F7,  F8,  F9,  W1")
   ' check fir equal number of cells in source and destination ranges
   srcCellsCnt = src.CountLarge
   If srcCellsCnt <> dst.CountLarge Then
      MsgBox ("Mismatch in the number of source - destination cells")
      Exit Sub
   End If
   With Sheet1
      If .Range("J4").Value = vbNullString Or .Range("I6").Value = vbNullString Then
          MsgBox "Please Make sure to enter and Inovice # and Date"
          Exit Sub
      End If
   End With       
   ' find the next free cell to write a record.
   ' try to find the free position checking ONLY columns A , E and F
   ' I could use "UsedRange" but there would be a commitment
   ' not to write anything anywhere eg a note which would exceed the record limit
   With Me.UsedRange
      Set lastUsedCell = Me.Cells(.row + .rows.CountLarge - 1, 1).End(xlUp)
      For cnt = 1 To maxServices
         If lastUsedCell.Offset(cnt, 4).Value2 = vbNullString And lastUsedCell.Offset(cnt, 5).Value2 = vbNullString Then
            ' found free cell, calculate the row to use as offset for destination range
            freeRow = lastUsedCell.row + cnt - 1 + gapBetweenInvoices
            Exit For
         End If
      Next
   End With
   
   ' if freeRow = 0 the sheet is FULL
   If freeRow = 0 Then
      MsgBox "sheet2 FULL!!! no other invoices can be added."
      Exit Sub
   End If
   
   ' copy source values in 1D array
   ReDim sv(1 To srcCellsCnt)
   cnt = 1
   For Each r In src
      sv(cnt) = r.Value2   'Trim(r.Value2)
      cnt = cnt + 1
   Next
   
   ' write values from 1D array to destination cells
   Application.ScreenUpdating = False
   cnt = 1
   For Each r In dst.Offset(freeRow)
      r.Value2 = sv(cnt)
      cnt = cnt + 1
   Next
End Sub

试试这个：（第一次尝试）

Sub Invoice_Save()
   Dim InvRow As Long, InvRowTmp As Long, LastItemRow As Long, InvItenRow As Long, TotalItems As Long
   Dim InvNumb As String
   
   With Sheet1
      If .Range("J4").value = Empty Or .Range("I6").value = Empty Then
         MsgBox "Please Make sure to enter and Inovice # and Date"
      End If
      InvRow = Sheet2.Range("A999999").End(xlUp).row + 1 ' Invoice Row
      InvRowTmp = Sheet2.Range("E999999").End(xlUp).row + 1 ' Invoice Row
      If InvRowTmp > InvRow Then InvRow = InvRowTmp
      InvRowTmp = Sheet2.Range("F999999").End(xlUp).row + 1 ' Invoice Row
      If InvRowTmp > InvRow Then InvRow = InvRowTmp
      InvNumb = .Range("J4").value ' Invoice Number
      Sheet2.Range("A" & InvRow).value = .Range("I6").value ' Date
      Sheet2.Range("B" & InvRow).value = InvNumb ' InvNumb
      Sheet2.Range("C" & InvRow).value = .Range("I8").value ' Customer
      Sheet2.Range("D" & InvRow).value = .Range("I10").value ' Provider
      Sheet2.Range("E" & InvRow).value = .Range("I12").value ' Service1
      Sheet2.Range("E" & InvRow + 1).value = .Range("I16").value ' Service2
      Sheet2.Range("E" & InvRow + 2).value = .Range("I20").value ' Service3
      Sheet2.Range("E" & InvRow + 3).value = .Range("I24").value ' Service4
      Sheet2.Range("E" & InvRow + 4).value = .Range("I28").value ' Service5
      Sheet2.Range("E" & InvRow + 5).value = .Range("I32").value ' Service6
      Sheet2.Range("E" & InvRow + 6).value = .Range("I36").value ' Service7
      Sheet2.Range("E" & InvRow + 7).value = .Range("I40").value ' Service8
      Sheet2.Range("E" & InvRow + 8).value = .Range("I44").value ' Service9
      Sheet2.Range("F" & InvRow).value = .Range("L14").value ' Quantity1
      Sheet2.Range("F" & InvRow + 1).value = .Range("L18").value ' Quantity2
      Sheet2.Range("F" & InvRow + 2).value = .Range("L22").value ' Quantity3
      Sheet2.Range("F" & InvRow + 3).value = .Range("L26").value ' Quantity4
      Sheet2.Range("F" & InvRow + 4).value = .Range("L30").value ' Quantity5
      Sheet2.Range("F" & InvRow + 5).value = .Range("L34").value ' Quantity6
      Sheet2.Range("F" & InvRow + 6).value = .Range("L38").value ' Quantity7
      Sheet2.Range("F" & InvRow + 7).value = .Range("L42").value ' Quantity8
      Sheet2.Range("F" & InvRow + 8).value = .Range("L46").value ' Quantity9
      Sheet2.Range("W" & InvRow).value = .Range("I48").value ' Notes
   End With
End Sub