Home » excel » excel – How to make a "copy-paste" macro run faster?

excel – How to make a "copy-paste" macro run faster?

Posted by: admin May 14, 2020 Leave a comment


I have written a macro in Excel VBA that basically copy-pastes 53 rows 1440 times, one under another, in order to populate two columns in a ~70000 row table. The macro works, but it takes about five minutes to run completely. This would be fine if I didn’t have to run this on ~1000 other files. I am looking for any way to speed up this process so that it doesn’t take 5 days to run.

I tried using the range copy method:

    Set range1 = {the table I'm copying} 
    Set range2 = {the cells I want to paste into} 
    range1.Copy range2

but it took just as long, if not longer.

Here is my current code:

    j = Cells(Rows.Count, 1).End(xlUp).Row
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    For i = 1 To 1440
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, 
              SkipBlanks _
        :=False, Transpose:=False
        ActiveWindow.SmallScroll Down:=56
        ActiveCell.Offset(j - 1, 0).Select
    Next i

I’m thinking the solution might have something to do with using sql in VBA, but I have yet to learn that syntax. Either way, any advice is greatly appreciated. Thank you for reading!

How to&Answers:

Load it all into an array and then output the entire array at the end. Code refactored to avoid the use of activate/select

Sub tgr()

    Dim wbDest As Workbook
    Dim wbData As Workbook
    Dim wsDest As Worksheet
    Dim wsData As Worksheet
    Dim aTemp() As Variant
    Dim aData() As Variant
    Dim SiteName As String
    Dim RepeatData As Long
    Dim ixTemp As Long
    Dim ixData As Long
    Dim ixCol As Long

    SiteName = "SiteName1"
    RepeatData = 1440

    Set wbDest = ThisWorkbook
    Set wbData = Workbooks("as_built_comp.xlsm")
    Set wsDest = wbDest.Worksheets(1)
    Set wsData = wbData.Worksheets(SiteName)

    With wsData.Range("C2:D" & wsData.Cells(wsData.Rows.Count, "C").End(xlUp).Row)
        If .Row < 2 Then Exit Sub   'No data
        aTemp = .Value
        ReDim aData(1 To .Rows.Count * RepeatData, 1 To .Columns.Count)
    End With

    For ixData = 1 To UBound(aData, 1)
        ixTemp = ((ixData - 1) Mod UBound(aTemp, 1)) + 1
        For ixCol = 1 To UBound(aTemp, 2)
            aData(ixData, ixCol) = aTemp(ixTemp, ixCol)
        Next ixCol
    Next ixData

    wsDest.Range("I12").Resize(UBound(aData, 1), UBound(aData, 2)).Value = aData

End Sub