Copying Master Worksheet

[rss01]

I have a workbook that has 2 worksheets "DATA" & "FOR"

In the data worksheet column A contains a store list, one row for eac
store.

I want to create a copy of worksheet "FOR" for each store in column
and name the worksheet the store name.

I have code that will do all this instead of making a duplicate copy o
"FOR" and renaming it I'm adding a new worksheet and copying a range o
cells from "FOR" and pasting them into each sheet. This works ok but
loose all my page setup that is in "FOR"

Below is the code I"m using. Any help would be apprectiaed.

Sub StoreData()

Dim c As Range 'range of cells
Dim ws As Worksheet 'worksheet to be added
Dim strWrkName As String 'worksheet name, needs to be a string so i
can be used in loop.
'for each cell in the range "StoreList" (which is a simple name
range)...
For Each c In Range("StoreList")
'... check to see if it exists (goes to function "WksExists")...
If WksExists(c.Value) = False Then '... if it doesn't exist ...
Set ws = Sheets.Add '... add a worksheet
ws.Name = c.Value '... make the name of the work sheet whatever i
currently in the cell
ws.Move After:=Sheets(Sheets.Count) '... move the worksheet to th
end of the list
End If
'... if it does exist, skip everything within the "If/End If" and d
the following
strWrkName = c.Value ' make the worksheet name a string.
Worksheets("FOR").Range("A1:H62").Copy _
Destination:=Worksheets(strWrkName).Range("A1") ' Go to the "FOR
worksheet, copy the data from A1 to H62,
'then go to the worksheet that matches th
cell name currently working on and paste.
Sheets(strWrkName).Range("B3").Value = c.Value ' put the worksheet nam
in cell B3 (this triggers formulas)

MsgBox "Missing Store Sheets have Been Created and Data Updated"

End Sub

Function WksExists(wksName As String) As Boolean
On Error Resume Next
WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Functio

 

[Dave Peterson]

Instead of copying the range, maybe you could just copy the entire FOR worksheet
(it'll keep the page setup) and name it nicely:

Option Explicit
Sub StoreData()

Dim c As Range
Dim ws As Worksheet
For Each c In Range("StoreList")
If wksExists(c.Value) = False Then
Worksheets("For").Copy after:=Sheets(Sheets.Count)
Set ws = ActiveSheet
On Error Resume Next
ws.Name = c.Value
If Err.Number <> 0 Then
MsgBox "couldn't rename: " & ws.Name & " to: " & c.Value
End If
On Error GoTo 0
ws.Range("b3").Value = c.Value
End If
Next c

MsgBox "Missing Store Sheets have Been Created and Data Updated"

End Sub
Function wksExists(myStr As String) As Boolean
On Error Resume Next
wksExists = CBool(Len(Worksheets(myStr).Name) > 0)