copy non empty rows from a subset of columns to another worksheet

Question

Total VBA noob here, so bear with me, please. I have a workbook that has 67 columns, of which I only need the data of 14 columns pasted into a new worksheet and then is formatted into a table. This source workbook is updated daily with new rows of data that I would like to update the new worksheet and table with the update data.

My Current workflow is as follows: Download Source Workbook with updates. I copy the source workbook into MasterList, as is no modifications. I make sure to copy only rows and columns with data.

In the Master List Sheet I placed an Update button, so that it copies the columns I need from MasterList to MasterTable.

I found a solution that copies the data but it appears that it copies all of the rows whether they have data or not. Resulting in the new table having 100,000+ rows and really slowing down my excel app and hanging my system.

Here is the code that I am using to accomplish the copy and paste. I

Sub Button1_Click()
    Worksheets("MasterList").Activate
    Worksheets("MasterList").Range("I:I,J:J,K:K,L:L,M:M,N:N,S:S,X:X,Y:Y,Z:Z,AA:AA,AC:AC,AD:AD").Select
    Selection.Copy
    Worksheets("MasterTable").Activate
    Worksheets("MasterTable").Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
End Sub

If hiding the unnecessary columns weren't so tedious every time I get a new update I could live with that set up, but I am hoping there is a faster more efficient way to accomplish this.

I appreciate any directions or suggestions.

Mech Mech · Accepted Answer · 2020-03-02T02:22:48

Don't use .select or .activate. It is resource heavy / slow.

Tested and working.

Sub test()
    ' These will help with the speed of your macro.
    ' This turns of calculations
    Application.Calculation = xlCalculationManual
    ' This runs the macro "behind the scenes"
    Application.ScreenUpdating = False

    ' Always dim your variables
    Dim lRow As Long
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim Sourcews As Worksheet: Set Sourcews = wb.Worksheets("MasterList")
    Dim Destinationws As Worksheet: Set Destinationws = wb.Worksheets("MasterTable")

    ' find the last row of the source ws
    lRow = Sourcews.Cells(Sourcews.Rows.Count, "I").End(xlUp).Row
    ' "select" from row 1 to the last row containing data and paste to the destination ws
    Sourcews.Range("I1:N" & lRow & ", S1:S" & lRow & ", X1:AA" & lRow & ", AC1:AD" & lRow).Copy Destination:=Destinationws.Range("A1")

    ' turn the calculations and screen updating back on
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

copy non empty rows from a subset of columns to another worksheet

1 Answers