Home > database >  I am trying to run a macro that includes some sheets and excludes others
I am trying to run a macro that includes some sheets and excludes others

Time:06-28

I have searched and though there are similar posts to what my title post alludes to, I haven't been able to find a specific one.

The code below works fine. It loops through my worksheets in my WB and excludes the ones listed in the IF statement below. Maybe I've been starring at the code too long but what I am trying to do is be able to not hard code each sheet name I want to exclude and create a separate sheet where I can simply enter the sheet names I want to exclude in the range A1:10 so the IF statement can nab the sheet names from this range. Thank you.

    Dim Ws As Worksheet

    For Each Ws In Worksheets
        If Ws.Name <> "MainMenu" And Ws.Name <> "All in One View" And Ws.Name <> "Complete" _
            And Ws.Name <> "LDD on Hold" And Ws.Name <> "LDD Projects in Queue" And Ws.Name <> "ON HOLD" _
            And Ws.Name <> "Blank" And Ws.Name <> "Project Assignments" Then
            
            Set rngData = Ws.UsedRange
            
            rngData.Offset(5, 1).Resize(rngData.Rows.Count - 5, rngData.Columns.Count - 3).Copy Sheet26.Range(ActiveCell.Address)
            Range("C6").End(xlDown).Select
            ActiveCell.Offset(1, 0).Select
        End If
    Next Ws

CodePudding user response:

Something like this should work for you. Make sure the name of your destination worksheet, and the name of your exclusion worksheet (I named it ExcludeSheets) are included in the list.

Sub tgr()
    
    Dim wb As Workbook:         Set wb = ActiveWorkbook
    Dim wsDest As Worksheet:    Set wsDest = wb.Worksheets(26)
    Dim wsExcl As Worksheet:    Set wsExcl = wb.Worksheets("ExcludeSheets")
    Dim rExclude As Range:      Set rExclude = wsExcl.Range("A1", wsExcl.Cells(wsExcl.Rows.Count, "A").End(xlUp))
    
    Dim aExclude() As Variant
    If rExclude.Cells.Count = 1 Then
        ReDim aExclude(1 To 1, 1 To 1)
        aExclude(1, 1) = rExclude.Value
    Else
        aExclude = rExclude.Value
    End If
    
    Dim ws As Worksheet, rCopy As Range, rDest As Range
    For Each ws In wb.Worksheets
        Select Case IsError(Application.Match(ws.Name, aExclude, 0))
            Case False   'do nothing, worksheet found to be in exclude list
            Case Else
                Set rCopy = ws.UsedRange.Offset(5, 1).Resize(ws.UsedRange.Rows.Count - 5, ws.UsedRange.Columns.Count - 3)
                Set rDest = wsDest.Cells(wsDest.Rows.Count, "C").End(xlUp).Offset(1)
                rCopy.Copy rDest
        End Select
    Next ws
    
End Sub

CodePudding user response:

Using Match() against a list of excluded sheets:

Dim Ws As Worksheet, rngExcl As Range

Set rngExcl = ThisWorkbook.Worksheets("list").Range("A1:A10")

For Each Ws In Worksheets
    If IsError(Application.Match(Ws.Name, rngExcl, 0) Then
        Set rngData = Ws.UsedRange
        
        With rngData
            .Offset(5, 1).Resize(.Rows.Count - 5, .Columns.Count - 3).Copy _
                 Sheet26.Range("C6").End(xlDown).Offset(1, 0)
        End With
        
    End If
Next Ws
  • Related