Gentag række x antal gangen i forhold tie start/slut dato

Option Explicit

Dim wb As Workbook
Dim wsData As Worksheet, wsBehandlet As Worksheet
Dim Area As Range
Dim ArrData() As Variant, ArrBehandlet() As Variant
Dim CountA As Integer, CountB As Integer, Count As Integer
Dim NewRow As Integer, MyRow As Integer

Sub BehandelData()
    SetVar
    BeregnRækker
    NewArray
    Indsæt
End Sub
Private Sub Indsæt()
    Set Area = wsBehandlet.Range("A2")
    Set Area = Range(Area, Area.Offset(NewRow - 1, 3))
    Area.Value = ArrBehandlet
End Sub
Private Sub NewArray()
    ReDim ArrBehandlet(1 To NewRow, 1 To 4)
    Count = 0
    For CountA = LBound(ArrData, 1) + 1 To UBound(ArrData, 1)
        MyRow = DateDiff("d", ArrData(CountA, 2), ArrData(CountA, 3))
        For CountB = 1 To MyRow + 1
            Count = Count + 1
            ArrBehandlet(Count, 1) = ArrData(CountA, 1)
            ArrBehandlet(Count, 2) = DateValue(ArrData(CountA, 2))
            ArrBehandlet(Count, 3) = DateValue(ArrData(CountA, 3))
            ArrBehandlet(Count, 4) = DateValue(ArrData(CountA, 2)) + (CountB - 1)
        Next
    Next
End Sub

Private Sub BeregnRækker()
    For CountA = LBound(ArrData, 1) + 1 To UBound(ArrData, 1)
        NewRow = DateDiff("d", ArrData(CountA, 2), ArrData(CountA, 3)) + NewRow + 1
    Next
End Sub

Private Sub SetVar()
    Set wb = ThisWorkbook
    Set wsData = wb.Sheets("Data") 'Navnet på Data arket
    Set wsBehandlet = wb.Sheets("Beregnet Data") 'Navnet på Behandlings arket
    Set Area = wsData.UsedRange
    ArrData = Area.Value
    NewRow = 0
End Sub