Thanks for your help on this. I have a solution that Per provided that works
very well but thanks for your help!

Tom

"dflak" wrote:

This is untested but you could set something up like:

Option Base 1

sub SetUpBase ()
Dim NumCopies as Long, iCopies as long
Dim CopyRanges() as String

NumCopies = 16
ReDim CopyRanges(NumCopies)

CopyRanges(1) = €œQ5:S5€�
CopyRanges(2) = O11:P12"
€¦

For iCopies = 1 to NumCopies

Sheets("Setup (Base)").Select
Range(CopyRanges(iCopies)).Select
Selection.Copy
Sheets("Worksheet 1").Select
Range(CopyRanges(iCopies)).Select
ActiveSheet.Paste

Next
€¦
End Sub

There is a reason I deliberately set up the CopyRanges as an undimensioned array intitally. First I didn't count how many copies you actually did. So the 16 may be wrong. You will have to change it to match the number of copies you make.

This makes the code a little more flexible in case you need to add, delete or change what you are copying.

The code can be made "expandable" - that is, instead of describing the ranges in the code, you could list them in a named dynamic range on the spreadsheet, and define them there. So you won't have to change code, you will only have to change the spreadsheet. Then NumCopies becomes NumCopies = Range("YourRangeName").Rows.Count.

To fill the array use:
For iCopies = 1 to NumCopies
CopyRanges(iCopies) = Range("YourRangeName").Cells(iCopies,1)
Next

Good Luck.

---
frmsrcurl: http://msgroups.net/microsoft.public...ple-worksheets
.