Searching for a more efficient way to copy a variable range from multiple sheets to a single sheet? Rows vary, Columns constant

• There are currently 17 sheets ("Site#")of data I copy to a summary sheet ("Data").

• The number of rows to be copied varies on each sheet, but the columns in range are always consistent (A:AT).

  • Row1:3 is ignored in the copy for all sheets

  • Row4 (the column headers) will be copied from "Site1" only

  • Row5 (the data values) will begin the copy for all remaining sites

  • Prefer to only copy the columns in the range

• Data Refresh occurs manually with button click (summary sheet clears and all sheets copy)

• Roughly 900 total lines of data copied.

This data can include formulas, conditional formatting, etc. which if possible go away on summary sheet by pasting only the values.

Thanks for any assistance.

I am new to VBA and could not find anything to help with this combination of questions.

Sub RefreshData()
Sheets("DATA").Cells.Clear

Application.Calculation = xlCalculationManual

' SITE1

   Dim LastRow As Long

   'Find last used row of sheet SITE1
   With Worksheets("SITE1")
      LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   End With

   'Find first row to paste values on sheet DATA
   With Worksheets("DATA")
      j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
   End With
   
   'Paste each row of SITE1 into DATA
   For i = 4 To LastRow
       With Worksheets("SITE1")
            .Rows(i).Copy Destination:=Worksheets("DATA").Range("A" & j)
            j = j + 1
       End With
   Next i
   
'SITE2

   'Find last used row of sheet SITE2
   With Worksheets("SITE2")
      LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   End With

   'Find first row to paste values on sheet DATA
   With Worksheets("DATA")
      j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
   End With
   
   'Paste each row of SITE2 into DATA
   For i = 5 To LastRow
       With Worksheets("SITE2")
            .Rows(i).Copy Destination:=Worksheets("DATA").Range("A" & j)
            j = j + 1
       End With
   Next i

' Show all rows and columns in DATA
Sheets("DATA").Cells.EntireRow.Hidden = False
Sheets("DATA").Cells.EntireColumn.Hidden = False

Call setCategories
Call setAge

ActiveWorkbook.RefreshAll

MsgBox "All Data Refreshed.", vbOKOnly
   
Application.Calculation = xlCalculationAutomatic
   
End Sub

Untested. but something like this should work (assuming everything is in the same workbook: adjust as needed)

Sub RefreshData()
    
    Dim wsData As Worksheet, wb As Workbook, ws As Worksheet, i As Long
    Dim data, lr As Long, cDest As Range
    
    Set wb = ThisWorkbook  'adjust as needed if macro is in a different workbook
    Set wsData = wb.Worksheets("Data")
    
    wsData.Cells.Clear
    Set cDest = wsData.Range("A5") 'first data destination
    
    Application.Calculation = xlCalculationManual
    
    For i = 1 To 17
        Set ws = wb.Worksheets("SITE" & i)
        If i = 1 Then ws.Range("A4:AT4").Copy wsData.Range("A4")
        lr = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
        If lr > 4 Then 'any data to copy?
            'read range values into a 2D 1-based array
            data = ws.Range("A5", ws.Cells(lr, "AT")).Value 'read to array
            cDest.Resize(UBound(data, 1), UBound(data, 2)).Value = data 'write values only
            Set cDest = cDest.Offset(UBound(data, 1)) 'next destination start
        End If
    Next i
    
    '...
    'etc etc
    '...
End Sub