Copy a range with variable rows from multiple sheets to a single sheet more efficiently

I copy 17 sheets ("Site#") of data to a summary sheet ("Data").
The number of rows to copy varies on each sheet.
The columns in the range are constant (A:AT).

• Rows 1:3 are ignored in the copy for all sheets

• Row 4 (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 lines of data to be copied.

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

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