extrapolate year from date

[bank]

I have a spreadsheet with columns 6/30/2010, 6/30/2011, 6/30/2012 etc.

I want to create new sheets within the same workbook with only the year as the label, so the resulting sheet labels will be 2010,2011,2012.

I don't want to hard code the year as the label, because the dates may change. I just want to be able to reference the year and use that as the label. Below is the code I have right now, but it labels the tabs "Jun-10", "Jun-11" etc.

Public Sub add_four_sheets()
Dim name1, name2, name3, name4 As String
Dim StrSrcSheet As String
 
StrSrcSheet = "Maintenance"
' add and rename four sheets
    name1 = Worksheets("Maintenance").Range("Y6").Text
    name2 = Worksheets("Maintenance").Range("AL6").Text
    name3 = Worksheets("Maintenance").Range("AY6").Text
    name4 = Worksheets("Maintenance").Range("BL6").Text
 
 'Add FYE10
    Worksheets.Add After:=Worksheets(Sheets.Count)
    ActiveSheet.Name = name1
    Worksheets(StrSrcSheet).Range("A1:A6").EntireRow.Copy Worksheets(name1).Range("A1")
    Worksheets(StrSrcSheet).Range("A1:A6").EntireRow.Copy
        Worksheets(name1).Range("A1").PasteSpecial xlPasteColumnWidths
 
'Add FYE11
    Worksheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = name2
        Worksheets(StrSrcSheet).Range("A1:A6").EntireRow.Copy Worksheets(name2).Range("A1")
        Worksheets(StrSrcSheet).Range("A1:A6").EntireRow.Copy
        Worksheets(name2).Range("A1").PasteSpecial xlPasteColumnWidths
        
'Add FYE12
     Worksheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = name3
        Worksheets(StrSrcSheet).Range("A1:A6").EntireRow.Copy Worksheets(name3).Range("A1")
        Worksheets(StrSrcSheet).Range("A1:A6").EntireRow.Copy
        Worksheets(name3).Range("A1").PasteSpecial xlPasteColumnWidths

'Add FYE13
     Worksheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = name4
        Worksheets(StrSrcSheet).Range("A1:A6").EntireRow.Copy Worksheets(name4).Range("A1")
        Worksheets(StrSrcSheet).Range("A1:A6").EntireRow.Copy
        Worksheets(name4).Range("A1").PasteSpecial xlPasteColumnWidths
End Sub()

 

[shg]

Does this work for you? It assumes the values in those four cells are Excel dates.

Public Sub AddFourSheets()
    Dim wks         As Worksheet
    Dim vsRng       As Variant
 
    Set wks = Worksheets("Maintenance")
 
    For Each vsRng In Array("Y6", "AL6", "AY6", "BL6")
        Worksheets.Add After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Format(wks.Range(vsRng).Value, "yyyy")
        wks.Rows("1:6").Copy
        ActiveSheet.Range("A1").PasteSpecial
        ActiveSheet.Range("A1").PasteSpecial xlPasteColumnWidths
    Next vsRng
End Sub

 

[bank]

Worked like a charm! Thanks!