كود او معادلة لاضافة سطور حسب الشهر الحالي وعدد الاقساط

[يوسف السيد]

السلام عليكم ورحمه الله وبركاته

ابحث عن حل لاضافة اسطر حسب عدد الاقساط واخر شهر سداد

 الملف المرفق به المعطيات وشكل النتائج المتوقعه

شاكر ومقدر كريم تعاونكم

الاقساط المستحقة.xlsx

[حسين مامون]

هذا ما استطعت التوصل اليه بالحلقات التكرارية

جرب

الاقساط المستحقة.xlsm

[يوسف السيد]

شكرا ا.حسن مأمون
ولكن الكود الذي تفضلت به يدرج سطور لجميع الاقساط المستحقة

فهل بالامكان ان يتوقف السرد عند الشهر المراد وهو هنا فبراير

[حسين مامون]

تفضل

الاقساط المستحقة (1).xlsm

[يوسف السيد]

جزيت خيرا وزادك الله من فضله
الحل رائع ويؤدي النتيجه بكفاءة

استاذ حسين اذا تكرمت استفسار
هل يمكن ات يكون سرد الشهور بعد اخر قسط مدفوع

بمعني انه اذا كان اخر قسط  مدفوع ديسمبر 2020

فيبدأ السرد من الشهر التالي وهو يناير 2021

اسف على الازعاج وكثرة الاسئلة

[حسين مامون]

جرب هذا الكود

Sub test()
Dim lr, lr2, lrw
Dim x, w, dt, rg
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
Range("n6:p10000").ClearContents
For x = 6 To lr
        Set rg = Cells(x, "c")
         dt = Cells(x, "b")
        If Cells(x, "c") >= 1 Then
        lr2 = Cells(Rows.Count, "n").End(xlUp).Row
        For w = 1 To rg
        lrw = Cells(Rows.Count, "p").End(xlUp).Row
         If dt = CDate(Range("p3")) Then GoTo 1
        Range("n" & lrw + 1) = Cells(x, 1)
        Range("O" & lrw + 1).Value = Format(DateAdd("m", 1, dt), "mm-yyyy")
        Range("p" & lrw + 1).Value = rg - 1
         dt = Format(DateAdd("m", 1, dt), "mm-yyyy")
         rg = rg - 1
        Next w
        End If
1: Next x
Application.ScreenUpdating = True

End Sub