Issue with VB macros in Excel not selecting the correct cells

Question

I've got a program that's meant to generate an invoice based off of data in a .csv file. It works as intended initially, creating the invoice for the first entry in a .csv, but then skips to the last entry and then randomly will select an empty cell in the 1 million range for some reason. This is my code for the "Next Invoice" macro that seems to be causing the issue:

Sub NextInvoiceShopOne()
    Application.ScreenUpdating = False
    Dim Invoice As String
    Dim dDate As String
    Dim ws As Worksheet
    Dim sName As String

    Range("I2").Value = Range("I2").Value + 1

    Sheets("Payments").Select
    ActiveCell.Offset(0, 3).Select
    ActiveCell.End(xlDown).Select
    ActiveCell.Offset(0, -3).Select
    Selection.Copy

    Sheets("Invoice").Select
    Range("B15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
End Sub

The data being pulled for the macro is stored as such (in 2 different files):

<vendor name>, <vendor sku>, <item name>, <item type (always constant)>, <quantity sold>, <total cost>, <default vendor price>

(lets call this file payments)

and

<vendor>, <address>, <city>, <state>, <zip code>, <email>    

(lets call this one vendors)

The report is supposed to pull vendor information from the payments file and match it to some data in the vendors file, and print the results on screen.

But what I really want to know is why only the first and last entries of the payments file get processed, then it skips to empty cells.

EDIT

Changed the code slightly to fix the empty cell selection issue

Sub NextInvoiceShopOne()
Application.ScreenUpdating = False
Dim Invoice As String
Dim dDate As String
Dim ws As Worksheet
Dim sName As String

Range("I2").Value = Range("I2").Value + 1

Sheets("Payments").Select
ActiveCell.Offset(0, 3).Select
Range(Range("A5"), Range("G5").End(xlDown)).Select
Do Until IsEmpty(ActiveCell.Offset(1, 0))
    ActiveCell.Offset(1, 0).Select
Loop
Selection.Copy

Sheets("Invoice").Select
Range("B15").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
End Sub

Answer 1

"but then skips to the last entry and then randomly will select an empty cell in the 1 million range for some reason"

ActiveCell.End(xlDown).Select - will select the very last cell in the ActiveCell column, which is why it brings you down to the 1,048,576th row.

ActiveCell.Offset(0, 3).Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(0, -3).Select

I would have made this a comment but my reputation score hasn't exceeded 50