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 the overview - but it only
does it for section of data at the moment.

I need to do the same actions for nine other sections that use different
defined range names...

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

Here are the steps that already happen in the macro:

First Run:

Collect the new data:
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 starting at cell 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 (columns (A:BL) but how many 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". (e.g. if the named 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
''''The above range needs to change to select the cell in the 1st column and
''''2nd row within the named range (currently using "OverviewfinalGroupOne")
Selection.Insert Shift:=xlDown

'''''Repeat the above macro (up to this point) for GroupTwo,
'''''GroupThree, etc through to GroupNine

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.

 

[Barb Reinhardt]

I'd create a sub that does what you want for each group. something like this

Sub Test(myRangeName as string)

'where you have "GroupOne", change to myRangeName

end sub

If it were me, I'd probably change the range names to
Group1, Group2, Group3, Group4

for i = 1 to 9
Call Test("Group" & i)

next i