Automating create copy of current tab with date

[JumboCactuar]

Hi,
i have a current tab with mondays date in cell A1 like 13/08/18 and the tab is named 13.08.18

how can i with VBA, create a copy into new tabs for every week in the year (or a specified amount)

i.e next tab will have 20/08/2018 with tab name 20.08.18

thanks for any help

 

[My Aswer Is This]

Are you saying you have

13.08.18​

In Range("A1")
And you want to make 52 copies of this sheet.

And give them names like 13.15.18 and next copy named 22.08.18 and so on?

 

[My Aswer Is This]

My mistake it would be:

And give them names like 13.15.18 and next copy named 20.08.18 and so on?​

 

[JumboCactuar]

Yes correct though the date in cell A1 is formatted as DD/MM/YYYY

52 would be good, or maybe an input for how many copies to replicate

13.08.18
20.08.18
27.08.18
03.09.18
...

 

[JumboCactuar]

Was thinking something like

date1 = range("A1).value

After loop or next ws

date1 = date1 +7

 

[JumboCactuar]

On the right track I think, just need a loop

Sub Test()
With ActiveSheet
ShName = Range("A1").Value +7
.Copy After:=Sheets(Worksheets.Count)
End With
Sheets(Worksheets.Count).Name = ShName
Sheets(Worksheets.Count).Activate
Sheets(Worksheets.Count).Range("A1").Value = ShName

'loop

End Sub

 

[JumboCactuar]

^ no luck with the above, adds new sheet but trouble with the renaming

 

[My Aswer Is This]

Try this:
Sheet names cannot have a / I'm using a -

Sub Sheet_Copy()
'Modified  8/15/2018  9:45:42 PM  EDT
Application.ScreenUpdating = False
Dim ans As Variant
ans = InputBox("Make how many copies")
If ans = "" Then MsgBox "You did not enter a number": Exit Sub
    For i = 1 To ans
        Sheets("13.08.18").Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = Format(DateAdd("d", i * 7, "8/13/2018"), "DD-MM-YYYY")
    Next

Application.ScreenUpdating = True
End Sub

 

[JumboCactuar]

Try this:
Sheet names cannot have a / I'm using a -

Sub Sheet_Copy()
'Modified  8/15/2018  9:45:42 PM  EDT
Application.ScreenUpdating = False
Dim ans As Variant
ans = InputBox("Make how many copies")
If ans = "" Then MsgBox "You did not enter a number": Exit Sub
    For i = 1 To ans
        Sheets("13.08.18").Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = Format(DateAdd("d", i * 7, "8/13/2018"), "DD-MM-YYYY")
    Next

Application.ScreenUpdating = True
End Sub

Thank you

This works perfectly

 

[My Aswer Is This]

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.