Macro to copy and rename sheet from list but only one at a time.

[awhiew]

Hello. Newbie here. I would like to create a macro that will create a copy of the active sheet ("25 May 2015") and rename it ("1 June 15") from a list on a separate sheet ("List"). Everytime I use the macro I would like the latest sheet to be copied and renamed to the next name on the list one at a time.

Is this possible? I've found ones that copy into multiple sheets from a list all at once but can't find how to do it one by one and creating a copy of the latest sheet (or active sheet if ran from the latest sheet).

Hope that makes sense.

Thanks

 

[RickXL]

Hi and welcome to the MrExcel Message Board.

You could try this. It does no error checking so if it can't find the date in the list or if the worksheet already exists etc it will just crash.
I have assumed that the list of sheet names are all valid dates and exist in column A of the worksheet called List starting in row 2.
The name of the existing sheet is converted to a date then it is looked up to get its row number.
That row number, when used as an offset from call A1 will return the next date.
A new sheet is copied from the active one and is renamed to the new name.

Sub NewSheet()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim varMatch As Variant
    
    With ThisWorkbook
        Set ws1 = .ActiveSheet
        Set ws2 = .Worksheets("List")
           
        varMatch = Application.Match(CLng(DateValue(ws1.Name)), ws2.UsedRange, 0)
        ws1.Copy after:=.Worksheets(.Worksheets.Count)
        .Worksheets(.Worksheets.Count).Name = Format(ws2.Range("A1").Offset(varMatch), "dd mmm yyyy")
    End With
    
End Sub

 

[awhiew]

Perfect!! Thanks so much RickXL for your time. Did exactly what I wanted.

If it's not too much trouble is there a way to error check? Missing dates in the list shouldn't be a problem. The only error I foresee is if someone runs the macro from an older sheet therefore trying to create a duplicate. In that instance if the macro didn't do anything that would be ideal.

Thanks again much appreciated

 

[RickXL]

Hi,

I have re-arranged it somewhat.

It now runs through the list of worksheets and finds the last worksheet in the list of dates. That way, it does not matter which sheet is active when you run the macro. It automatically knows to use the sheet with the latest date as the basis for the copy. It finds the next name at the same time.

If the next name is blank you get an error message.

Sub NewSheet()

    Dim ws As Worksheet
    Dim ws1 As Worksheet
    Dim varMatch As Variant
    Dim strCurName As String
    Dim strNexName As String
    Dim maxRow As Long
    
    With ThisWorkbook
    
        ' Find the last dated worksheet
        Set ws1 = .Worksheets("List")
        maxRow = 0
        For Each ws In .Worksheets
            If IsDate(ws.Name) Then
                varMatch = Application.Match(CLng(DateValue(ws.Name)), ws1.UsedRange, 0)
                If IsNumeric(varMatch) Then
                    If varMatch > maxRow Then maxRow = varMatch
                End If
            End If
        Next
        
        ' Set the current and next names
        strCurName = Format(ws1.Range("A1").Offset(maxRow - 1), "dd mmm yyyy")
        strNexName = Format(ws1.Range("A1").Offset(maxRow), "dd mmm yyyy")
        
        ' Check the next name
        If strNexName = "" Then
            MsgBox "No new date found in the List worksheet." & vbCrLf & _
                    "Please add some new dates."
            Exit Sub
        End If
        
        ' Copy the last sheet and give it the next name
        .Worksheets(strCurName).Copy after:=.Worksheets(.Worksheets.Count)
        .Worksheets(.Worksheets.Count).Name = strNexName

    End With

End Sub

 

[awhiew]

Hi RickXL,

Thanks so much for that. I thought I had done something wrong but just realised that the date was formatted with yyyy this time instead of yy. Figured that bit out and so it works perfectly!!

Thanks so much again. Really appreciate it ray:

 

[RickXL]

Hi,

Looking at my original code and your question it should have had four digit years all along.

The values in the List sheet can be whatever you want as long as Excel recognises them as dates.
If you need to change the macro the only two lines that matter are:

        strCurName = Format(ws1.Range("A1").Offset(maxRow - 1), "dd mmm yyyy") 
        strNexName = Format(ws1.Range("A1").Offset(maxRow), "dd mmm yyyy")

I am pleased it does what you want.

Bye for now.