Option Explicit

Sub jjj()
Dim arr(), dtBegin As Date, dtEnd As Date, dtEndTmp As Date, i&, j&
    arr = Range("D6:E10")
    j = 0
    For i = 1 To UBound(arr, 1)
        dtBegin = CDate(arr(i, 1))
        dtEnd = CDate(arr(i, 2))
        With WorksheetFunction
            If .EoMonth(dtBegin, 0) < .EoMonth(dtEnd, 0) Then
                Do
                    dtEndTmp = .Min(.EoMonth(dtBegin, 0), dtEnd)
                    [G6].Offset(j).Resize(, 2).Value = Array(dtBegin, dtEndTmp)
                    j = j + 1
                    dtBegin = DateAdd("d", 1, dtEndTmp)
                Loop While dtBegin < dtEnd
            Else
                [G6].Offset(j).Resize(, 2).Value = Array(dtBegin, dtEnd)
                j = j + 1
            End If
        End With
    Next i
    With [G6].CurrentRegion
        .Columns.AutoFit
        .Rows.AutoFit
    End With
End Sub