Hjælp med dato i vba kode ved generering af ny ark

til det første så prøv lige det her.
Husk at tage den sidste function med, da det er den der finder en dato ud fra årstal og ugenummer.

Sub genere_ark()
    Dim arkNr As Integer
    Dim ark_navn As String
    Dim ws As Worksheet
    Dim lYear As Long
    Dim vDates(5)
    lYear = Application.InputBox("Indtast årstal 'ÅÅÅÅ' : ", "Årstal", , , , , , 1)
    Application.DisplayAlerts = False
    While ActiveWorkbook.Sheets.Count > 1
        ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count).Delete
    Wend

    For arkNr = 2 To 4
        Sheets(1).Copy After:=Worksheets(Worksheets.Count)
        Set ws = ActiveSheet
        vDates(0) = FDIW(lYear, arkNr)                'man
        vDates(1) = vDates(0) + 1                    'tir
        vDates(2) = vDates(0) + 2                    'ons
        vDates(3) = vDates(0) + 3                    'tor
        vDates(4) = vDates(0) + 4                    'fre
        ws.Range("H10:H15") = WorksheetFunction.Transpose(vDates)
        ws.Name = "Uge " & arkNr
    Next
End Sub

Function FDIW(år, uge)
  FDIW = DateSerial(år, 1, 7 * uge - 3 - Weekday(DateSerial(år, 0, 0), 3)) - 1
End Function

For arkNr = 2 To 4 skal selvfølgelig ændres til
For arkNr = 2 To 52

Denne makro starter fra det aktive ark og arbejder sig frem.
dvs marker fx. arket Uge 24, så slettes fra 24 og op og nye ark dannes med basis i uge 24 arket

Sub genere_ark()
    Dim arkNr As Integer
    Dim ark_navn As String
    Dim ws As Worksheet
    Dim wsStart As Worksheet
    Dim lYear As Long
    Dim vDates(5)
    Dim wsStartNr As Long
    Dim nr
    'initializer
    lYear = Application.InputBox("Indtast årstal 'ÅÅÅÅ' : ", "Årstal", , , , , , 1)
    Set wsStart = ActiveSheet
    'find ugenummer på startarket (det som skal kopieres frem)
    wsStartNr = CLng(Mid(wsStart.Name, 4, 3))
   
    'slet alle ark hvor ugenummer er større end startarket
    Application.DisplayAlerts = False
    For Each ws In ActiveWorkbook.Worksheets
        nr = Trim(Mid(ws.Name, 4, 3))
        If InStr(1, ws.Name, "Uge") > 0 And nr > wsStartNr Then ws.Delete
    Next
    Application.DisplayAlerts = True
   
    'opret nye fra startugen med det aktive ark som skabelon
    For arkNr = wsStartNr + 1 To 52
        wsStart.Copy After:=Worksheets(Worksheets.Count)
        Set ws = ActiveSheet
        vDates(0) = FDIW(lYear, arkNr)                'man
        vDates(1) = vDates(0) + 1                    'tir
        vDates(2) = vDates(0) + 2                    'ons
        vDates(3) = vDates(0) + 3                    'tor
        vDates(4) = vDates(0) + 4                    'fre
        ws.Range("H10:H15") = WorksheetFunction.Transpose(vDates)
        ws.Name = "Uge " & arkNr
    Next
End Sub

Function FDIW(år, uge)
  FDIW = DateSerial(år, 1, 7 * uge - 3 - Weekday(DateSerial(år, 0, 0), 3)) - 1
End Function

i funktionen FDIW skal du lige fjerne det sidste -1, ellers starter ugen på en søndag :-)

Hej Bak - jeg har prøvet din kommentar 11.08 og det ser meget lovende ud. :0)
Desværre er der en fejl i mit spørgsmål. Jeg skulle have datoerne udskrevet i et range: H10:L10 og ikke H10:H15. Hvis jeg ændre det i koden, så får jeg samme dato på alle ugens dage. Hvad er årsagen til det?
Kan jeg få datoen udskrevet som Man 01-08. osv.

Den sidste del har jeg endnu ikke nået at test, men den ser også godt ud. :0))

udskift
ws.Range("H10:H15") = WorksheetFunction.Transpose(vDates)

med
ws.Range("H10:L10") = vDates
ws.Range("H10:L10").NumberFormat = "ddd dd/mm/yy"

Hej Bak - jeg har 3 spørgsmål til første del:
1. kan jeg angive mere end et interval i linien: ws.Range("H10:H15") = WorksheetFunction.Transpose(vDates), hvis jeg ønsker dato i f.eks. 2 linier.

2. kan jeg få ugedagen til at starte med stort begyndelsbogstav?

3. min kode starter med at indsætte datoer i uge 2, kan jeg ændre koden, så den også sætter i uge 1?

1. jeg forstår ikke helt hvad du mener, men du kan bare gentage linien og ændre range
2. nej, det er ms's opfattelese af hvorledes dansk skal skrives. Det kommer helt automatisk og er sat i windows indstillinger.
3 det kigger jeg lige på senere

add. 1. jeg har to rækker med datoer  på samme ark, og så gik spørgsmålet på, om man kunne gøre det i samme linie: noget ala ws.Range("H10:L10", "H30:L30") = vDates, eller om det er nødvendigt at bruge to linier.  ovenstående virker ikke, men spørgsmålet er om jeg gør det forkert.

Hej igen - har lige afprøvet din kode fra kommentar 11.42. Den er bare helt perfekt. :0))

Sub genere_ark()
    Dim arkNr As Integer
    Dim ark_navn As String
    Dim ws As Worksheet
    Dim wsStart As Worksheet
    Dim lYear As Long
    Dim vDates(5)
    Dim wsStartNr As Long
    Dim nr
    'initializer
    lYear = Application.InputBox("Indtast årstal 'ÅÅÅÅ' : ", "Årstal", , , , , , 1)
    Set wsStart = ActiveSheet
    'find ugenummer på startarket (det som skal kopieres frem)
    wsStartNr = CLng(Mid(wsStart.Name, 4, 3))

    'slet alle ark hvor ugenummer er større end startarket
    Application.DisplayAlerts = False
    For Each ws In ActiveWorkbook.Worksheets
        nr = Trim(Mid(ws.Name, 4, 3))
        If InStr(1, ws.Name, "Uge") > 0 And nr > wsStartNr Then ws.Delete
    Next
    Application.DisplayAlerts = True

    vDates(0) = FDIW(lYear, wsStartNr)                'man
    vDates(1) = vDates(0) + 1                        'tir
    vDates(2) = vDates(0) + 2                        'ons
    vDates(3) = vDates(0) + 3                        'tor
    vDates(4) = vDates(0) + 4                        'fre
    wsStart.Range("H10:L10") = vDates
    wsStart.Range("H10:L10, H30:L30").NumberFormat = "ddd dd/mm/yy"
    wsStart.Range("H30:L30") = vDates
    'opret nye fra startugen med det aktive ark som skabelon
    For arkNr = wsStartNr + 1 To 52
        wsStart.Copy After:=Worksheets(Worksheets.Count)
        Set ws = ActiveSheet
        vDates(0) = FDIW(lYear, arkNr)                'man
        vDates(1) = vDates(0) + 1                    'tir
        vDates(2) = vDates(0) + 2                    'ons
        vDates(3) = vDates(0) + 3                    'tor
        vDates(4) = vDates(0) + 4                    'fre
        ws.Range("H10:L10") = vDates
        ws.Range("H30:L30") = vDates
        ws.Name = "Uge " & arkNr
    Next
End Sub

Function FDIW(år, uge) As Long
    FDIW = DateSerial(år, 1, 7 * uge - 3 - Weekday(DateSerial(år, 0, 0), 3))
End Function

Hej Bak - den sidder lige i skabet, den løser min opgave. Jeg har dog stadig en lille udfordring i den. Arket skal bruges af to brugere - altså et delt ark. Det giver problemer i den del af rutinen, der sletter.

For Each ws In ActiveWorkbook.Worksheets
        nr = Trim(Mid(ws.Name, 4, 3))
        If InStr(1, ws.Name, "Uge") > 0 And nr > wsStartNr Then ws.Delete
Next

Kender du årsagen?

Jeg har fundet frem til, at man ikke kan slette et ark, sålænge en workbook er delt. er det ikke korrekt? og er der en alternativ mulighed?

Det er sikkert korrekt, da man i et delt ark også har historik og man derved ville slette for meget.

Et alternativ er måske (ikke testet) at vha. en makro at chekke om den er åben af andre og hvis ikke, så ophæve delingen midlertidig, lave ændringerne og slå deling til igen.

Det faldre vist uden for det oprindelige spørgsmål, men har du et bud på en  makro, som checker om der er flere samtidige brugere af arket?  Er det muligt via VBA kode at slå delingen fra?

Håber du kan hjælpe med ovenstående, ellers tusinde tak for hjælpen med mit spørgsmål.:0)) Læg venligst et svar, så kvitere jeg med velfortjente point.

Hej Bak - et svar? så jeg kan få lukket denne tråd

ja, gerne !