CODEWITHSUNDEEP
excelvbaloops
AccessFan
AccessFan

Reputation: 11

How to run a macro that excludes some sheets?

The code works. It loops through my worksheets in my workbook and excludes the ones listed in the IF statement below.

I am trying to not hard code each sheet name I want to exclude.

I want to create a separate sheet where I enter the sheet names to exclude in the range A1:10 so the IF statement can nab the sheet names.

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

Upvotes: 0

Views: 218

Answers (2)

Tim Williams
Tim Williams

Reputation: 166351

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

Upvotes: 0

tigeravatar
tigeravatar

Reputation: 26650

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

Upvotes: 1

Related Questions