Automatisk navneændring af fanenavne

Har testet koden, synes den kører OK, se link
http://www.gratisupload.dk/f/8qkefsg329/

Ja, men som du selv skriver, så skal man ind og opdatere i hver enkel fane. Jeg har dog i mellemtiden fundet en anden løsning, men er så i stedet strandet ved et andet problem.

Jeg har lavet et eksempel her:
http://www.gratisupload.dk/f/8qkrg4k6si/

Jeg har dog nu det problem, at når jeg ændre startårstallet med en, så ændre den ikke alle fanenavne. Dette kan man komme uden om ved at trykke på knappen overover et par gange (den kører den makro jeg har lavet). Hvis man så ændre årtallet med 4 år, så skifter alle fanenavne.

Det er denne makro jeg har lavet under moduler
Sub NameWS()
    On Error Resume Next
    For Each ws In ThisWorkbook.Worksheets
        ws.Name = Left(ws.Cells(2, 2).Value, 31)
    Next
    On Error GoTo 0
End Sub

Og så har jeg indsat denne kode under hver ark

Private Sub Worksheet_Change(ByVal Target As Range)
    NameWS
End Sub

Ved ikke om det bare blev mere forvirrende nu...

Årsagen til at arknavnene ikke ændre sig automatisk ved skift af et år. er at der allerede findes et ark af samme navn. Hvis du indsætter et ark mere, vil arkene først skifte navn for hver 5. år

Ja, okay. Det giver jo god mening.

Men så kan det nok ikke lade sig gøre?

Det kan sikkert godt lade sig gøre, men der får du nok brug for en VBA haj og der kan jeg ikke hjælpe. Det kan være der er nogle der kikker med, som har et bud. Go' weekend

ok. Tak for dit svar i hvert fald :)

Jeg har selv fundet en løsning nu, og excel mappen ændre nu alle arknavnene uanset om navnet allerede findes.


Denne macro skrives under moduler:
Sub NamesWS()

    Application.ScreenUpdating = False
   
    Dim SheetCount As Integer, Counter As Integer, WSName As String, NewName As String
   
    SheetCount = ThisWorkbook.Worksheets.Count
   
    For Counter = 1 To SheetCount
   
        Worksheets(Counter).Activate
        WSName = Worksheets(Counter).Name
       
        If WSName <> "Start" Then
            NewName = Cells(2, 2).Value
            ActiveSheet.Name = NewName & "X"
        End If
   
    Next Counter
   
    For Counter = 1 To SheetCount
   
        Worksheets(Counter).Activate
        WSName = Worksheets(Counter).Name
       
        If WSName <> "Start" Then
       
            WSName = Application.WorksheetFunction.Substitute(WSName, "X", "")
            ActiveSheet.Name = WSName
        End If
   
    Next Counter
   
    Worksheets("Start").Activate
   
    Range("E5").Activate
   
    Application.ScreenUpdating = True

End Sub

Og denne skrives under arkkoden:
Private Sub Worksheet_Change(ByVal Target As Range)
    NamesWS
End Sub