VBA to collect all populated columns from visible sheets to Master sheet

user_11803558 0
Viewed 74

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
vba excel
2 Answers

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
user_98140690

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
user_22206650
Related