Indsætte tomme linjer ved manglende datoer

Helst ikke i VBA, men gerne makro, det kan jeg som regel overskue :-).

Hvad er din definition på forskellen?
Makroer er VBA.

Måske er jeg ikke så kvik. Jeg mener bare, at jeg har indspillet makroer og husker det som nogenlunde overskueligt...
VBA og sætte det ind, plejer at volde mig problemer.
mvh Johnny

Hej Johnny

Du er velkommen til at sende filen (@-adresse under min profil)/uploade den - så skal jeg forsøge med VBA..

Public Sub indsætTommeRækker()
Dim sidsteRække As Long, ræk As Long, antalTomme As Integer, slutFlag As Boolean
Dim ptMåned As Integer, ptÅr As Integer, ptFørste As Date, ptAntalDage As Integer
Dim ptDato As Date, nextDato As Date, startOk As Boolean, slutOk As Boolean
Rem Klargøring
    sidsteRække = ActiveCell.SpecialCells(xlLastCell).Row
   
    ptMåned = Month(Range("A1"))
    ptÅr = Year(Range("A1"))
    ptFørste = "01-" & CStr(ptMåned) & "-" & CStr(ptÅr)
    ptAntalDage = hentAntalDage(ptFørste)
    startOk = False
    slutOk = False
    slutFlag = False
   
    Application.ScreenUpdating = False
   
    For ræk = 1 To 9999
        antalTomme = 0
        ptFørste = "01-" & CStr(ptMåned) & "-" & CStr(ptÅr)
       
        If Range("A" & ræk) <> "" Then
            Range("A" & ræk).Select
            ptDato = Selection
           
Rem test månedens start (fra den 1. til ptDato)
            While ptDato > ptFørste And startOk = False
                Rows(ræk & ":" & ræk).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                ptFørste = DateAdd("d", 1, ptFørste)
                antalTomme = antalTomme + 1
            Wend
           
            startOk = True
           
            If antalTomme > 0 Then
                Range("A" & ræk + antalTomme).Select
            End If
           
            nextDato = Selection.Offset(1, 0)
           
            While DateAdd("d", 1, ptDato) < nextDato
                If DateDiff("d", ptDato, nextDato) > 1 Then
                    antalTomme = antalTomme + 1
                    Rows(ræk + 1 & ":" & ræk + 1).Insert
                    ptDato = DateAdd("d", 1, ptDato)
                Else
                    antalTomme = antalTomme - 1
                End If
            Wend
            ræk = ræk + antalTomme
        Else
            antalTomme = 0
            startOk = False
           
Rem test månedens afslut - fra ptDato til sidste dag i mpneden
            While ptDato < CStr(ptAntalDage) & "-" & CStr(ptMåned) & "-" & CStr(ptÅr)
                Rows(ræk & ":" & ræk).Select
                Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                ptDato = DateAdd("d", 1, ptDato)
                antalTomme = antalTomme + 1
            Wend
            ræk = ræk + antalTomme
        End If
    Next ræk
End Sub
Function hentAntalDage(dato)
    hentAntalDage = Day(DateSerial(Year(dato), Month(dato) + 1, 1) - 1)
End Function

Det virker fantastisk og hurtigt.
Tak

Johnny

Selv tak..