اذا كنت تريد التواريخ حصراً فذلك يأخذ عرض العامود B والعامود C كبير لأنه يمكن ان يكون عدد التوريخ المطلوبة 3 / 4 5 / 10 أو أكثر
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