Error - Do Until with iRows and kRows?

Hello! I have created a template Order Form that a user is to fill out. When they are done, they click a "Ship" button. That button opens up a workbook with a list of all of the Shipments placed through clicking that button and adds the new parts being ordered to the list. In addition, the Packing List is saved under its own file with a unique ShipNo.

The problem is that when the parts are being put into the new list, they are repeating over each other instead of adding to the list. So, if the list already has 3 parts in it and I add 3 more, those parts are overwritten by the new ones. My code is listed below. I placed green comments where I have tried different ideas. Sometimes it would add only one part to the list, sometimes it would add none. I need it to add all of them. Any help would be greatly appreciated

Sub ShipTest()
    
Application.ScreenUpdating = False

'This section copies the Packing List and Shipping Document and moves it to a new Workbook created
    Dim ShipNo As Long
    ShipNo = Sheets("2018 Packing List").Cells(3, 11).Value  'this cell is hidden in white ink so that the ShipNo is correct in cell to left of it
    Sheets("2018 Packing List").Cells(3, 11).Value = Sheets("2018 Packing List").Cells(3, 11).Value + 1
    Filenm = Sheets("Order Form").Cells(1, 2).Value 'reference to the filename
    Sheets(Array("2018 Packing List", "Shipping Request Form")).Copy
    ChDir "C:\Users\Z645352\Desktop\Test1\ShippingDoc\"
    ActiveWorkbook.SaveAs FileFormat:=xlOpenXMLWorkbookMacroEnabled, Filename:= _
        "C:\Users\Z645352\Desktop\Test1\ShippingDoc" & Filenm & "2018" & ShipNo & ".xlsm"
    
    ActiveWindow.Close savechanges:=False
    

'This section copies the necessary information from Order Form to Shipments
Sheets("Order Form").Activate
OrderNo = Range("B2").Value
Dim PartNo(100) As String
Dim Quantity(100) As Integer

Dim iRow As Integer
   iRow = 8 'start one row early or it will skip the first row of the order
   Do Until IsEmpty(Cells(iRow, 1))
   iRow = iRow + 1
   PartNo(iRow) = Cells(iRow, 1).Value
   Quantity(iRow) = Cells(iRow, 5).Value
   Loop
maxRow = iRow
iRow = 9 'added this line to stop error of adding extra empty row

'opens up the ship list
Workbooks.Open Filename:= _
        "C:\Users\Z645352\Desktop\Test1\WorkbookB.xlsm"

'name the kRow
Sheets("Shipments").Activate
kRow = 6

'-------------------------THIS IS WHERE THE ERROR OCCURS-----------------------
    Do Until iRow = maxRow
'   Do Until IsEmpty(Cells(kRow, 1))
'   iRow = maxRow 'do until the list is done
    
Cells(kRow, 1).Value = PartNo(iRow)
Cells(kRow, 4).Value = Quantity(iRow)
Cells(kRow, 3).Value = Filenm
Cells(kRow, 2).Select 'add a hyperlink to the cell where the ShipNo appears
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="C:\Users\Z645352\Desktop\Test1\ShippingDoc\" & Filenm & "2018" & ShipNo & ".xlsm", TextToDisplay:=Filenm & "2018" & ShipNo
    
'    Do Until iRow = iRow + 1 'so that the code will not continue to rewrite in the same row over and over again
     iRow = iRow + 1
     kRow = kRow + 1
    Loop
'---------------------------------end of errors-----------------------------------
    
ActiveWorkbook.Save

Application.CutCopyMode = False
Application.ScreenUpdating = True


End Sub

As of right now, is still also overwriting previous rows in the list. I've added an example order form and shipments list as attachments for help. Any ideas?