Try this code



VBA Code:
--------------------


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


Application.ScreenUpdating = False
Application.EnableEvents = False

Sheets("GRP Data Collection").Cells.Clear


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

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


If WorksheetFunction.CountA(DestSh.UsedRange) = 0 Then
LastRowDest = 1
Set DestLoc = DestSh.Range("A1")
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"
Exit For
End If

sh.Range("GRPResults").Copy
With DestLoc
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

End If
Next

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



--------------------


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=183175

Microsoft Office Help