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