Excel VBA copy range to a new sheet after 1,048,576 rows

Question

So I wrote a fairly simple Macro in VBA that updates a set of variables, then copying and pasting the updated values into a new sheet. The problem is that the volume is getting a bit overwhelming now, thus reaching the 1,048,576 row limit in Excel, causing the code to crash.

I would like to update it so that whenever the rows limitation is reached, the script begins copying the cells to a new sheet (say, "FinalFile2","FinalFile3", etc) until it's fully executed.

Sub KW()
'
' Exact KWs
'
Dim i, j, LastRow As Long
Dim relativePath As String

i = 2
j = 2

'LastRowValue'
Sheets("Output").Select
LastRow = Rows(Rows.Count).End(xlUp).Row - 1

'Clean final output'
  Sheets("FinalFile").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("A1").Select

'Set Variables in Variables sheet'

Do

'Var 1'
    Sheets("Names").Select
    Range("A" & i).Select
    Selection.Copy
    Sheets("Variables").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Var 2'
    Sheets("Names").Select
    Range("B" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 'Var 3'
    Sheets("Names").Select
    Range("C" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

 'Var 4'
    Sheets("Names").Select
    Range("D" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


 'Var 5'
    Sheets("Names").Select
    Range("E" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


  'Var 6'
    Sheets("Names").Select
    Range("F" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

   'Var 7'
    Sheets("Names").Select
    Range("G" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("G2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


    'Var 8'
    Sheets("Names").Select
    Range("H" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("H2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False



     'Var 9'
    Sheets("Names").Select
    Range("I" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("I2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False



     'Var 10'
    Sheets("Names").Select
    Range("J" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("J2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False



     'Var 11'
    Sheets("Names").Select
    Range("K" & i).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Variables").Select
    Range("K2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Copy and Paste'

    Sheets("Output").Select
    Range("A2:AP2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("FinalFile").Select
    Range("A" & j).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'update counters'

i = i + 1
j = j + LastRow

'end of loop condition'

Sheets("Names").Select

Loop Until IsEmpty(Cells(i, 1))



End Sub

How long does this run until the sheet is full? It sounds like you need to use a variable sheet and create a new one one `j` reaches 1,048,576 and reset `j`. Also you should definitely remove the selections http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros — arcadeprecinct, Jul 08 '16 at 09:49
Also aren't you overwriting the values in the variables sheet? It all get's pasted to row 2. — arcadeprecinct, Jul 08 '16 at 09:59
The longer I look at this the more confused I am. You Copy a lot of different lines of the `"Names"` sheet to the same row of the `"Variables"` sheet and the same line from the `"Output"` sheet to `"FinalFile"` over and over always skipping `lastRow` lines — arcadeprecinct, Jul 08 '16 at 10:26

arcadeprecinct · Answer 1 · 2016-07-08T11:20:40.643

Here are some tips how to improve your code. I am not going into the issues I mentioned in my comment on the original question but just concentrate on specific parts of the code:

Remove Selections. The general pattern is instead of

something.Select
Selection.Dosomenthing

you use

something.Dosomething

In your case:

Sheets("Names").Select
Range("A" & i).Select
Selection.Copy
Sheets("Variables").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

becomes

Sheets("Names").Range("A" & i).Copy
Sheets("Variables").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Use variables to reference your sheets like this:

Dim nameSheet as Worksheet
Dim varSheet as Worksheet
Dim finalSheet as Worksheet

Set nameSheet = Sheets("Names")
Set varSheet = Sheets("Variables")
Set finalSheet = Sheets("FinalFile")

Now you can use

finalSheet.Range(...).Pastespecial ...

and use Set finalSheet = Sheets("FinalFile2") once you run out of space

Don't copy cells next to each other one by one. You are copying cell Ai to A2 then Bi to B2. Just copy the range Ai:Ki to A2:K2 (although I don't see the point of this)

Don't use Copy if you don't need to. Instead of

someRange.Copy
someOtherRange.PasteSpecial Paste:=xlPasteValues

you can use

someOtherRange.Value = someRange.Value

(make sure the sizes are the same)

Disable Screenupdating using Application.Screenupdating = False (set it to True after you're done) when you're doing a lot of insertions. It can speed up a macro a lot.

As to your actual question, do as Tom suggests, add

If j > 1048576 Then
    j = 2
    Set finalSheet = Sheets("FinalFile2") 'maybe create the new sheet at this point
End If

score 0 · Answer 2 · answered Jul 08 '16 at 10:00

You can add

j = j + lastRow
If j = 1048576 Then j = 2

BUT you should definitely clean up this code. .selections are a really slow way to do stuff like this. Look into this and try to avoid .Copy & .Paste. Just set your target cells to the values of your source with an =. This also saves a lot of time.

Edit: And definitely take a look at the link posted by @arcadeprecinct

Excel VBA copy range to a new sheet after 1,048,576 rows

2 Answers2