Macro to Copy and Paste Special Not Working Properly

Hello,

I am having an issue with my macro. It says "You can't paste this here because the Copy area and paste area aren't the same size."

The object of my macro:

When receiving a new list of invoices, because of how Excel extracts the info from our software, it repeats the information twice or more, but without the ITEM ID. Therefore, I have a macro that selects all the info from Row 6 and on, copies everything in the NEW INVOICES sheet, pastes only the rows with an ITEM ID at the bottom of the previous sheet, then deletes the NEW INVOICES sheet.

Problem:

When there are only two rows (one that is a duplicate with a blank in the ITEM ID), I receive the aforementioned error. However, when there are multiple rows with ITEM IDs, it works correctly.

Here is my Macro's code:

Sub TransferNewRegister()

Dim iRow As Long

For iRow = 1000 To 7 Step -1
If Cells(iRow, "J") = "" Then
Rows(iRow).Delete
End If
Next iRow

Application.Run "'2018 Processed_Invoices.xlsm'!Select_ALL"
Selection.Copy
ActiveSheet.Previous.Select
Application.Run "'2018 Processed_Invoices.xlsm'!BottomCell"
Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=True, Transpose:=False
ActiveSheet.Next.Delete
End Sub

HERE is a sample of the spreadsheet for your perusal:

[ATTACH]n1205178[/ATTACH]

Any help is appreciated.

Quote from NoSparks

This line of Select_All()

Code

ActiveSheet.Range(Selection, Selection.End(xlDown)).Select

results in 1048571 rows being selected for copy, and there aren't that many rows available to paste to.
I tried this and it works. I wouldn't think the 5 blank rows being pasted at the bottom would matter.

Code

Sub Select_ALL()
'
' Select_ALL Macro
'
' Keyboard Shortcut: Ctrl+Shift+A
'


Range("A6").CurrentRegion.Offset(5).Select


End Sub

Display More

Thank you, that could also work, however is there any possibility of it not selecting the bottom five blank rows?

Quote from jolivanes

Code

Sub Maybe()
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
Range("A6:K" & lr).Copy Sheets("Fixed Invoices").Cells(Rows.Count, 1).End(xlUp).Offset(1)
End Sub

Change the "Fixed Invoices" sheet name as required.

Thank you Jolivanes, but that code did not work.