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