Edit code - exclude sheets

[Steph]

Hello. I have the below piece of code that consolidates all visible sheets
with the exception of a few. Unfortunately, the number of sheets I need
excluded keeps growing, and I have keep editing the code. Is there a way to
have the code reference a worksheet (say called "Exclude"), and exclude the
sheets named in a certain range, rather than editing this line of code:
If ws.Name <> DestSh.Name And ws.Name <> "Total Signal" And ws.Name
<> "Upload" Then
Thank you!

Sub Consolidate()

Dim ws As Worksheet
Dim DestSh As Worksheet
Dim shLast As Long
Dim Last As Long

Set DestSh = Worksheets("Upload")
For Each ws In Worksheets
If ws.Name <> DestSh.Name And ws.Name <> "Total Signal" And ws.Name
<> "Upload" Then
Last = LastRow(DestSh)
shLast = LastRow(ws)
ws.Range(ws.Rows(1), ws.Rows(shLast)).Copy
'DestSh.Cells(Last + 1, 1)
DestSh.Cells(Last + 2, 1).PasteSpecial Paste:=xlPasteValues
End If
Next

End Sub

Function LastRow(ws As Worksheet)
On Error Resume Next
LastRow = ws.Cells.Find(What:="*", _
After:=ws.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

 

[Ron de Bruin]

Hi Steph

Try this one

Use a dynamic range name for the list in the sheet Exclude
http://www.contextures.com/xlNames01.html#Dynamic


Sub Consolidate()
Dim ws As Worksheet
Dim DestSh As Worksheet
Dim shLast As Long
Dim Last As Long

Set DestSh = Worksheets("Upload")
For Each ws In Worksheets
If ws.Name <> DestSh.Name And ws.Name <> "Exclude" And IsError(Application.Match(ws.Name,
Worksheets("Exclude").Range("A1:A3"), 0)) Then
Last = LastRow(DestSh)
shLast = LastRow(ws)
ws.Range(ws.Rows(1), ws.Rows(shLast)).Copy
'DestSh.Cells(Last + 1, 1)
DestSh.Cells(Last + 2, 1).PasteSpecial Paste:=xlPasteValues
End If
Next

End Sub

Function LastRow(ws As Worksheet)
On Error Resume Next
LastRow = ws.Cells.Find(What:="*", _
After:=ws.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

 

[Don Guillett]

try OR

 

[Steph]

Thanks Ron. Where does the named range get used in the code? I named it
Exclude.

 

[Ron de Bruin]

Change A1:A3 to Exclude

 

[Bob Phillips]

Sub Consolidate()

Dim ws As Worksheet
Dim DestSh As Worksheet
Dim shLast As Long
Dim Last As Long
Dim iPos As Long

Set DestSh = Worksheets("Upload")
For Each ws In Worksheets
iPos = 0
On Error Resume Next
iPos = Application.Match(ws.Name, Range("myRange"), 0)
On Error GoTo 0
If iPos = 0 Then
Last = LastRow(DestSh)
shLast = LastRow(ws)
ws.Range(ws.Rows(1), ws.Rows(shLast)).Copy
'DestSh.Cells(Last + 1, 1)
DestSh.Cells(Last + 2, 1).PasteSpecial Paste:=xlPasteValues
End If
Next

End Sub



--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

 

[Steph]

Hi Bob. Thanks for the response. I tried the updated code, and it appears
as if it is consolidating the sheets that I have in the named range to
exclude. Am I doing something wrong? Thanks for your help!!

 

[Steph]

Whoops. Sorry Bob. Typo on my part. Works great. Thanks so much!!