Repeat the macro using different ranges

[BeSmart]

Hi All
I have a macro that is working great - it creates an overview by searching
worksheets for data / coping & pasting values into an overview - but it only
does it for section of data.

I need to do the same actions (find and paste into specific sections of the
overview) for nine other sections...

Should I just create 9 macros and link the macros with "Call XXX"? Or is
there a way to do this automatically (via the one macro) so that I don't need
9 long ones?

Here are the steps that already happen in the macro:

First Run:
The macro clears all old data in all cells on the "collection" worksheet.

It then searches existing worksheets for a named range "GroupOne" and
copies/pastes the data found (as values & with formatting) into the
collection worksheet from A1.
The results are always within columns (A:BL) but the number of rows will vary.

Update Overview:
The macro then goes to the "overview template" worksheet and selects the
defined name range "OverviewfinalGroupOne" (variable range therefore named)
and clears all old content

Now it goes back to the collection worksheet to;
select all the "new" data (fixed columns (A:BL) but the number of rows will
vary)
sort the data - against column G in descending order
copy and insert the data into the "Overview template" starting at a specific
point....

Currently I've got it starting at cell "A44", but that cell will change
going forward - I need to insert copied cells into the cell that is in the
first column, 2nd row down within the named range I'm currently using e.g.
"OverviewfinalGroupOne". (Range A43:BL84 it select cell A44 & inserts copied
cells from there)

At this point, I need the macro to do all of the above again - but with the
following changes:

Named range GroupOne becomes GroupTwo
Named range OverviewfinalGroupOne becomes OverviewfinalGroupTwo
GroupOneRng becomes GroupTwoRng (or can this be "set" again for 2nd run and
the name re-used??)

I have to repeat the macro through to GroupNine / OverviewfinalGroupNine
Then I finish by deleting all unnecessary rows on the Overview Template
(i.e. delete the row if the cell in column A is blank).

Here is the current Code with named ranges for the First Run:

Sub CopyGroupSections()

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 GroupOneRng As Range
Dim myRange As Range
Dim myRange1 As Range

lastrow = Cells(Rows.Count, "A").End(xlUp).Row

Application.ScreenUpdating = False
Application.EnableEvents = False

Sheets("Collection").Cells.Clear
Set DestSh = ActiveWorkbook.Worksheets("Collection")

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

Set GroupOneRng = Nothing
On Error Resume Next
Set GroupOneRng = sh.Range("GroupOne")
On Error GoTo 0

If GroupOneRng Is Nothing Then
Else

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

GroupOneRng.Copy
With DestLoc
..PasteSpecial xlPasteValues
..PasteSpecial xlPasteFormats
End With
Application.CutCopyMode = False

End If
End If
Next


Sheets("Overview Template").Select
Application.Goto Reference:="overviewfinalGroupOne"
Selection.ClearContents

Sheets("Collection").Select
Range("A1").Select
Range("A1:BL" & Cells(Rows.Count, "A").End(xlUp).Row).Select
Selection.Sort Key1:=Range("G1"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Selection.Copy

Sheets("Overview Template").Select
Range("A44").Select
'''' Above range needs to change to select the cell in the 1st column and
2nd row within the
'''' named range (e.g. currently using "OverviewfinalGroupOne")
Selection.Insert Shift:=xlDown

'''''Repeat the above macro (to this point) for GroupTwo, GroupThree etc
through to GroupNine """""
''''Finish the macro with the following

Range("A41").Select
Set myRange = Sheets("Overview Template").Range("A41:A" & lastrow)
For Each c In myRange
If UCase(c.Value) = "" Then
If myRange1 Is Nothing Then
Set myRange1 = c.EntireRow
Else
Set myRange1 = Union(myRange1, c.EntireRow)
End If
End If
Next
If Not myRange1 Is Nothing Then
myRange1.Delete

Range("C17").Select
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Any help would be greatly appreciated.

 

[BeSmart]

I Apologize - I just posted this to the wrong "group".
I will re-post to the "Programming" Group.