VBA to set Range/ Print area in consolidating the Master Sheet

Question

I have this VBA code which is used to consolidate the different tabs to one single sheet.Now the issue here is its taking too long to copy each line item to one single sheet. Need an update so that i could set print area as range and copy the sheets back to one.

 ActiveWorkbook.Worksheets("Master Sheet").Activate
    Rows("2:" & Rows.Count).Cells.ClearContents

    totalsheets = Worksheets.Count
    For i = 1 To totalsheets

    If Worksheets(i).Name <> "Master Sheet"  Then
    lastrow = Worksheets(i).Cells(Rows.Count, 1).End(xlUp).Row


            For j = 2 To lastrow

            Worksheets(i).Activate
            Worksheets(i).AutoFilterMode = False
            Worksheets(i).Rows(j).Select
            Selection.Copy
            Worksheets("Master Sheet").Activate                               

            lastrow = Worksheets("Master Sheet").Cells(Rows.Count, 1).End(xlUp).Row

            Worksheets("Master Sheet").Cells(lastrow + 1, 1).Select
            ActiveSheet.Paste
            Application.CutCopyMode = False

            Next
            End If
            Next
            MsgBox "Completed"
            ActiveWorkbook.Save
End Sub

the line items is not always the same, so how do i set copy all items at once? by setting a range? would you be able to provide me some source? — Vignesh R, Mar 06 '20 at 20:43
Please [edit your question](https://stackoverflow.com/review/suggested-edits/25543364) instead of adding info in comments — cybernetic.nomad, Mar 06 '20 at 20:44
[this may be useful](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) — cybernetic.nomad, Mar 06 '20 at 20:45

score 0 · Accepted Answer · answered Mar 06 '20 at 21:02

First of all, avoid selecting worksheets and cells: Worksheets(i).Activate, Rows(j).Select. This is the most time-consuming. Usually it can be replaced with direct links.

Next, don't repeat Worksheets(i).AutoFilterMode = False inside the loop for j, it will be enough to do it once before For j = 2 To lastrow.

Third, don't copy row-by-row. Instead, copy the entire sheet:

Dim lastCell As Range
Set lastCell = Sheets("Sheet1").Range("A1").SpecialCells(xlLastCell)
Sheets("Sheet1").Range(Range("A1"), lastCell).Copy

FaneDuru · Answer 2 · 2020-03-07T07:09:40.750

Try this code, please. It it is fast, working mostly in memory, using arrays:

    Sub testConsolidate()
       Dim sh As Worksheet, shM As Worksheet, lastRowM As Long, arrUR As Variant

        Set shM = ActiveWorkbook.Worksheets("Master Sheet")
        shM.Rows("2:" & Rows.Count).Cells.Clear

        For Each sh In ActiveWorkbook.Worksheets
            If sh.Name <> "Master Sheet" Then
                sh.AutoFilterMode = False
                lastRowM = shM.Cells(Cells.Rows.Count, 1).End(xlUp).row
                arrUR = sh.UsedRange.Offset(1).value 'copy from row 2 down
                shM.Cells(lastRowM + 1, 1).Resize(UBound(arrUR, 1), _
                                            UBound(arrUR, 2)).value = arrUR
            End If
        Next
        MsgBox "Completed"
        ActiveWorkbook.Save
    End Sub

VBA to set Range/ Print area in consolidating the Master Sheet

2 Answers2