Hi All
I'm a novice that needs help please..... sorry - I've tried but I'm stuck....
(one workbook, heaps of worksheets)

I've created a macro that runs a set of actions for multiple named ranges by
calling each (see code below)
It finds / copies / pastes data from different worksheets & named ranges
into an overview.

The macro adds a 1 or 2 or 3 to "collectionMT" and repeats the actions
against each named ranges:
CollectMT1, CollectMT2, CollectMT3, CollectMT4 etc through to CollectMT9

I don't know how to do the same (in the same macro) for the destination
named ranges?
Data is inserted into the second set of named ranges on the overview:
overviewMT1, overviewMT2, overviewMT3, overviewMT4 etc through to overviewMT9

They are numbered the same as the 1st set and they live together e.g.
collectionMT1 and overviewMT1 have to run in the same macro,
then collectionMT2 and overviewMT2 have to run together etc

I've marked the two times where the sub refer to the overviewMT1 (etc) named
ranges and needs to rotate through the numbers.
Thanks for your help in advance!

Sub MTcollection()

For i = 1 To 9
Call Test("collectionMT" & i)

Next i

End Sub

Sub Test(collectionMT As String)

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 MTRng 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").Visible = True
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 MTRng = Nothing
On Error Resume Next
Set MTRng = sh.Range(collectionMT)
'' The above named range already changes to collectionMT2, collectionMT3,
collectionMT4 etc
On Error GoTo 0
If MTRng 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
MTRng.Copy
With DestLoc
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
Application.CutCopyMode = False
End If
End If
Next

Sheets("Overview Template").Select
Application.Goto Reference:="OverviewMT1"
'''''''''''overviewMT1 will change to overviewMT2, overviewMT3, overviewMT4
etc

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
Range("C:C").Select
With Selection
..HorizontalAlignment = xlLeft
End With
Range("A1:BL" & Cells(Rows.Count, "A").End(xlUp).Row).Select
Selection.Copy

Range(overviewMT1).Resize(1, 1).Offset(1, 0).Insert shift:=xlDown
'''''''''''''''overviewMT1 will change to overviewMT2, overviewMT3,
overviewMT4 etc

Range("A44").Select
Sheets("Collection").Visible = False
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

--
BeSmart