Edit code - exclude sheets
 

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

Edit code - exclude sheets
 

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

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Steph" wrote in message ...
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

Edit code - exclude sheets
 

try OR

--
Don Guillett
SalesAid Software

"Steph" wrote in message
...
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

Edit code - exclude sheets
 

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


"Ron de Bruin" wrote in message
...
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

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Steph" wrote in message
...
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

Edit code - exclude sheets
 

Change A1:A3 to Exclude

--
Regards Ron de Bruin
http://www.rondebruin.nl


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


"Ron de Bruin" wrote in message
...
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

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Steph" wrote in message
...
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

Edit code - exclude sheets
 

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" wrote in message
...
Thanks Ron. Where does the named range get used in the code? I named it
Exclude.


"Ron de Bruin" wrote in message
...
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

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Steph" wrote in message
...
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

Edit code - exclude sheets
 

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!!

"Bob Phillips" wrote in message
...
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" wrote in message
...
Thanks Ron. Where does the named range get used in the code? I named
it
Exclude.


"Ron de Bruin" wrote in message
...
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

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Steph" wrote in message
...
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

Edit code - exclude sheets
 

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

"Steph" wrote in message
...
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!!

"Bob Phillips" wrote in message
...
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" wrote in message
...
Thanks Ron. Where does the named range get used in the code? I named
it
Exclude.


"Ron de Bruin" wrote in message
...
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

--
Regards Ron de Bruin
http://www.rondebruin.nl


"Steph" wrote in message
...
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