Tüm Daireleri Borçlandır butonu eklenmiştir. ekteki örneği inceleyip geri bildirimde bulununuz. 

Yeni Butona Eklenip - Revize Edilen Kodlar.

    If vbYes = MsgBox(Me.IlkTarih & " / " & Me.SonTarih & " tarihleri arası aylık borçlandırma yapılsın mı?", vbCritical + vbYesNo + vbDefaultButton2, "Aylık servis") Then

Dim rT As New ADODB.Recordset

Dim rS As Recordset

Dim sOrGu As String

Dim TaR As Date

sOrGu = "SELECT Daireler.Daire FROM Daireler;"

rT.Open sOrGu, CurrentProject.Connection, adOpenKeyset, adLockOptimistic

Do Until rT.EOF

TaR = Me.IlkTarih

    If Me.Bedel = 0 Then: MsgBox "AİDAT BORCU SIFIR OLAMAZ", vbCritical, "bİLGİ": Exit Sub

        Set rS = CurrentDb.OpenRecordset("Hareketler")

        Do Until CVDate(islemtarihi) >= CVDate(Me.SonTarih)

            If Month(CVDate(Me.IlkTarih)) = 12 Then Me.IlkTarih = Day(CVDate(Me.IlkTarih)) & ".01." & Year(CVDate(Me.IlkTarih)) + 1: GoTo Devam

            If Month(CVDate(Me.IlkTarih)) <= 11 Then Me.IlkTarih = Day(CVDate(Me.IlkTarih)) & "." & Month(CVDate(Me.IlkTarih)) + 1 & "." & Year(CVDate(Me.IlkTarih)): GoTo Devam

Devam:

            islemtarihi = CVDate(Me.IlkTarih)

            rS.AddNew

            rS.Fields("Tarih") = CVDate(islemtarihi)

            rS.Fields("Daire") = rT!Daire

            rS.Fields("Borc") = Me.Bedel

            rS.Fields("Alacak") = 0

            rS.Fields("Doviz") = "TL"

            rS.Fields("Aciklama") = Year(CVDate(islemtarihi)) & "/" & Month(CVDate(islemtarihi)) & ".ay aidatı"

            rS.Update

        Loop

  Me.IlkTarih = TaR

      islemtarihi = Null

        rS.Close

rT.MoveNext

Loop

        MsgBox "Önümüzdeki dönem borçlar oluşturuldu.", vbInformation, "İşlem Tamam"

    Else

    End If