New to VBA here
I have a workbook with 30 sheets. Depending on the project different sheets are in scope. When in scope they will be unhidden and populated with data. All sheets have the same pre-defined columns from column B:N. What I want to do, is when everyone gave their input on the unhidden sheets, to collect all this information to one master sheet with only the populated rows. Not including the data from hidden sheets, as those obviously still will have the columns stated and thus have data. So only data from unhidden sheets is needed
I used below code, but it only retrieves information from one sheet
Option Explicit
Sub Create_Summary()
Dim sh As Worksheet, sumSht As Worksheet
Dim i As Long
Set sumSht = Sheets("Summary")
sumSht.Move after:=Worksheets(Worksheets.Count)
For i = 1 To Worksheets.Count - 1 ' once you moved "Summary" sheet as the workbook last one, you skip it by limiting loop to the penultimate sheets index
Worksheets(i).Range("B:M,N:N").Copy Destination:=sumSht.Cells(1, sumSht.Columns.Count).End(xlToLeft).Offset(, 1) ' qualify all destination references to "Summary" sheet
Next i
sumSht.Columns(1).Delete ' "Summary" sheet first column gest skipped by the above loop, so delete it
End Sub
CodePudding user response:
Create a Summary From Visible Worksheets
Option Explicit
Sub CreateSummary()
Const dName As String = "Summary"
Const dFirstCellAddress As String = "A1"
Const sColsAddress As String = "B:N"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Application.ScreenUpdating = False
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
dws.Move After:=wb.Sheets(wb.Sheets.Count)
dws.UsedRange.Clear
Dim dfCell As Range: Set dfCell = dws.Range(dFirstCellAddress)
Dim sws As Worksheet
Dim srg As Range
Dim i As Long
Dim n As Long
For i = 1 To Worksheets.Count - 1 ' exclude 'dws' (last worksheet)
Set sws = wb.Worksheets(i)
If sws.Visible = xlSheetVisible Then
n = n 1
Set srg = Intersect(sws.UsedRange, sws.Columns(sColsAddress))
If n > 1 Then ' all but the first worksheet; exclude headers
Set srg = srg.Resize(srg.Rows.Count - 1).Offset(1)
Else ' first worksheet
srg.Rows(1).Copy
dfCell.PasteSpecial xlPasteColumnWidths
End If
srg.Copy dfCell
Set dfCell = dfCell.Offset(srg.Rows.Count)
'Else ' worksheet is not visible; do nothing
End If
Next i
Application.Goto Reference:=dws.Cells(1), Scroll:=True
Application.ScreenUpdating = True
MsgBox "Summary created.", vbInformation
End Sub
CodePudding user response:
I don't see why this would only copy from one sheet, it seems as though it will do all visible, at least that is what it does for me.
Here's how to change the code to ignore hidden sheets
Sub Create_Summary()
Dim sh As Worksheet, sumSht As Worksheet
Dim i As Long
Set sumSht = Sheets("Summary")
sumSht.Move after:=Worksheets(Worksheets.Count)
For i = 1 To Worksheets.Count - 1 ' once you moved "Summary" sheet as the workbook last one, you skip it by limiting loop to the penultimate sheets index
If Worksheets(i).Visible = xlSheetVisible Then
Worksheets(i).Range("B:N").Copy Destination:=sumSht.Cells(1, sumSht.Columns.Count).End(xlToLeft).Offset(, 1) ' qualify all destination references to "Summary" sheet
End If
Next i
sumSht.Columns(1).Delete ' "Summary" sheet first column gest skipped by the above loop, so delete it
End Sub