Hi All

I'm trying to adjust the following code which some amazing experts from this
discussion group have written for me - but (being a novice) I obviously
haven't done it properly...
Your help would be appreciated:

The macro searches all workbooks except "Overview Template", GRP Wkly
Collection, the destination worksheet & hidden worksheets.

It needs to finds all worksheets where the defined range named:
"GRPResults", exists.
For all those worksheets, it copies the GRPResults range, and pastes
values/formats into the destination worksheet - creating a list of data from
all worksheets.

If it finds a worksheet that doesn't have the defined range "GRPResults" it
gives the user a message to say that this worksheet will be excluded and then
does just that.

At the moment the macro seems to stop running (with no error msg) when it
finds a worksheet that doesn't have the defined range named "GRPResults" and
does nothing??? What am I doing wrong??

Sub CopyGRPSections()

Dim sh As Worksheet
Dim DestSh As Worksheet
Dim LastRowDest As Long
Dim NewRowDest As Long
Dim LastRowSource As Long
Dim DestLoc As Range
Dim TestRng As Range

Application.ScreenUpdating = False
Application.EnableEvents = False

Sheets("GRP Qtrly Collection").Range("A40:BJ3000").Cells.Clear

Set DestSh = ActiveWorkbook.Worksheets("GRP Qtrly Collection")

For Each sh In ActiveWorkbook.Worksheets
If sh.Name < "Overview Template" And sh.Name < "GRP Wkly Collection" And
sh.Name < DestSh.Name And sh.Visible = True Then


'''''''''''Where it doesn't find the defined range named "GRPresults" on the
worksheet it needs to exclude that worksheet and continued through the others
& complete the code tasks on worksheets it did find


On Error Resume Next
Set TestRng = sh.Range("GRPResults") '''''' Should a defined range name
have "speech marks"?"
On Error GoTo 0

If TestRng Is Nothing Then
MsgBox sh.Name & " worksheet will be excluded"
Else

If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
LastRowDest = 40
Set DestLoc = DestSh.Range("A40")
Else
LastRowDest = DestSh.Range("A" & Rows.Count).End(xlUp).Row
NewRowDest = LastRowDest + 1
Set DestLoc = DestSh.Range("A" & NewRowDest)
End If

LastRowSource = sh.Range("A" & Rows.Count).End(xlUp).Row

If LastRowSource + LastRowDest DestSh.Rows.Count Then
MsgBox "There are not enough rows in the Destsh"

End If
Exit For

TestRng.Copy
With DestLoc
..PasteSpecial xlPasteValues
..PasteSpecial xlPasteFormats
End With

End If
End If
Next

Application.Goto DestSh.Cells(1)
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


--
Thank for your help
BeSmart