ممكن تعديل لملف البيانات منه وله بالتاريخ ليحضر الرصيد السابق

Option Explicit



Sub My_Summation()

    With Application

    .ScreenUpdating = False

    .Calculation = xlCalculationManual

    End With

Dim R As Worksheet, Sh As Worksheet

Dim Date1 As Date, Date2 As Date

Dim K%, Ro_r%, Ro_sh%, x%, col%, t%

Dim Look_Range As Range, Bol As Boolean

Dim My_sum#, SuM_Befor#



Set R = Sheets("Repport")

R.Range("B2:E26").ClearContents

Date1 = Application.Min(R.Range("F2:G2"))

Date2 = Application.Max(R.Range("F2:G2"))

Ro_r = R.Cells(Rows.Count, 1).End(3).Row



For K = 4 To 5

    Set Sh = Sheets(R.Cells(1, K) & "")

    Sh.Range("A1").CurrentRegion.Interior.ColorIndex = xlNone

    Set Look_Range = Sh.Range("A1:Ac1")

    Ro_sh = Sh.Cells(Rows.Count, 1).End(3).Row

        For x = 2 To Ro_r - 1

            If Not Bol Then

            col = Look_Range.Find(R.Cells(x, 1), lookat:=1).Column

            Bol = True

            End If

          

          For t = 2 To Ro_sh

                If Sh.Cells(t, 1) < Date1 Then

                SuM_Befor = SuM_Befor + Val(Sh.Cells(t, col))

                 Sh.Cells(t, col).Interior.ColorIndex = 6

                End If

            If Sh.Cells(t, 1) >= Date1 And Sh.Cells(t, 1) <= Date2 Then

             My_sum = My_sum + Val(Sh.Cells(t, col))

             Sh.Cells(t, col).Interior.ColorIndex = 35

            End If

          Next t

          R.Cells(x, K) = My_sum: My_sum = 0: Bol = False

          R.Cells(x, K - 2) = SuM_Befor: SuM_Befor = 0

         

       Next x

Next K

    With Application

    .ScreenUpdating = True

    .Calculation = xlCalculationAutomatic

    End With



End Sub