Time save macro to copy sheets

[tonywatsonhelp]

Hi Everyone

I Have a sheet called "Mon Wk1"
That I need to copy to make every day of the week and for Wk1 - Wk5


so for example:
"Mon Wk1"
"Tue Wk1"
all the way to
"

Sun Wk5"

​

Please help if you can

Thanks

Tony

 

[JackDanIce]

Tony, in a column list all the sheet names you want to create, then adjust the code below:

Sub New_Sheets

Dim SheetNames as variant: SheetNames = Sheets("Sheet with new sheet names in Range A1_A35").cells(1,1).resize(35).Value
Dim wksSource  as Worksheet: Set wksSource = Sheets("CopyMe")
Dim x  as Long

Application.ScreenUpdating = False

For x = Lbound(SheetNames, 1) to Ubound(SheetNames, 1)
  wksSource.Copy After:=Sheets(Sheets.Count)
  Sheets(Sheets.Count).Name = SheetNames(x, 1)
Next x

Application.ScreenUpdating = True

Erase SheetNames: Set wksSource = Nothing

End Sub

Delete the helper sheet afterwards if you want.

 

[tonywatsonhelp]

Ok thank you JackDanIce
Thanks
Tony

 

[jmacleary]

Or you could try this which just requires your initial sheet to be called 'Master'

Sub MakeSheets()
Dim rng As Variant
rng = Array("Sun ", "Sat ", "Fri ", "Thu ", "Wed ", "Tue ", "Mon ")
For counter = 5 To 1 Step -1
For Each rngElement In rng
    ThisWorkbook.Sheets("Master").Copy After:=Sheets("Master")
    ThisWorkbook.ActiveSheet.Name = rngElement + "Wk" + Format(counter)
Next
Next counter
End Sub