SOLVED

How can I copy and paste multiple sheets at once while keeping my row/column formatting?

Copper Contributor

I have tried many different things and nothing is working.  I want to copy the first sheet and pasted it into the other 25 sheets, while keeping the row/column formatting (as well as all the formatting.)  Also, I would like to keep the headers - the one on the left is a date (Design, Date).   I want it to bring up the day's date of when I worked on the file.   HELP!  Thanks!  (I am using Windows 10 Pro) Office Excel version 2013.

 

(Forgive me if this posted 2x - I couldn't find the 1st post)

7 Replies
I have already created the sheets and they are dated 2 weeks apart. Now, I want to copy the data in the 1st sheet - as shown in the attached file. And, keep the row/column formatting.

@kvhpkh I'd delete the additional sheets, then run the macro to create new copies. That's much easier than trying to get everything just right if the sheets exist already.

I tried that and it asked me "what year?" When I entered 2023 it gave me a run time error 1004 and said "that name has been taken, try another".
best response confirmed by VI_Migration (Silver Contributor)
Solution

@kvhpkh 

Try this version:

Sub CreateSheets()
    Dim y As Long
    Dim w As Long
    Dim d As Date
    Dim i As Long
    Dim s As Worksheet
    y = InputBox(Prompt:="Enter the year", Default:=Year(Date) + 1)
    w = Weekday(DateSerial(y, 1, 1), vbSaturday)
    d = DateSerial(y, 1, 1) + 14 - w
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For i = Worksheets.Count To 2 Step -1
        Worksheets(i).Delete
    Next i
    Set s = Worksheets(1)
    For i = 1 To 25
        s.Copy After:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Name = Format(d + 14 * i, "mmm d")
    Next i
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
1 best response

Accepted Solutions
best response confirmed by VI_Migration (Silver Contributor)
Solution

@kvhpkh 

Try this version:

Sub CreateSheets()
    Dim y As Long
    Dim w As Long
    Dim d As Date
    Dim i As Long
    Dim s As Worksheet
    y = InputBox(Prompt:="Enter the year", Default:=Year(Date) + 1)
    w = Weekday(DateSerial(y, 1, 1), vbSaturday)
    d = DateSerial(y, 1, 1) + 14 - w
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For i = Worksheets.Count To 2 Step -1
        Worksheets(i).Delete
    Next i
    Set s = Worksheets(1)
    For i = 1 To 25
        s.Copy After:=Worksheets(Worksheets.Count)
        Worksheets(Worksheets.Count).Name = Format(d + 14 * i, "mmm d")
    Next i
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

View solution in original post