Sub test()

    Dim i As Long, son As Long, k As Long

    Dim ilk As Date, ikinci As Date

    Const alan As String = "D" 'D sütunu icin---O sütun icin O yazilacak sadece D yerine

    Const satirBas As Byte = 4 '4.satirdan baslandigi icin

    

    Application.ScreenUpdating = False

    With ThisWorkbook.Sheets("Sayfa1")

       son = .Cells(Rows.Count, 2).End(3).Row

       .Range(.Cells(satirBas, alan), .Cells(Rows.Count, .Columns(alan).Offset(, 1).Column)).Clear

       If son < satirBas Then GoTo varis

        For i = satirBas To son

            ilk = .Cells(i, 2)

            ikinci = .Cells(i, 3)

            bas = WorksheetFunction.EoMonth(.Cells(i, 2).Value, -1) + 1

            bitis = WorksheetFunction.EoMonth(.Cells(i, 3).Value, -1) + 1

            

            .Cells(Rows.Count, alan).End(3)(2, 1).Value = Format(bas, "mmmm-YYYY")

            .Cells(Rows.Count, alan).End(3)(1, 2).Value = Day(WorksheetFunction.EoMonth(ilk, 0)) - Day(ilk)

            .Cells(Rows.Count, alan).End(3).Resize(, 2).Interior.Color = vbYellow

            

            Do While bas <> bitis

                 bas = WorksheetFunction.EoMonth(bas, 0) + 1

                .Cells(Rows.Count, alan).End(3)(2, 1).Value = Format(bas, "mmmm-YYYY")

                .Cells(Rows.Count, alan).End(3)(1, 2).Value = Day(WorksheetFunction.EoMonth(bas, 0))

            Loop

            .Cells(Rows.Count, alan).End(3)(1, 2).Value = Day(WorksheetFunction.EoMonth(ikinci, 0)) - Day(ikinci)

            .Cells(Rows.Count, alan).End(3).Resize(, 2).Interior.Color = vbYellow

        Next

        .Columns(alan).Offset(, 1).HorizontalAlignment = xlCenter

    End With

    MsgBox "Bitti", vbInformation

    Exit Sub

varis:

    Application.ScreenUpdating = True

    MsgBox "Hata", vbCritical

End Sub