تغير فى كود التقرير لمستر سليم الممتاز

Option Explicit

Sub get_special_columns()

Dim D As Worksheet

Dim Sh As Worksheet

Dim Ar(), Min_date As Date, Max_date As Date

Dim K%, t%, Arr_sh()

Dim My_ro%, m%, ro%, my_sum#, x%

K = 2

Set D = Sheets("DataReport")

D.Rows.Hidden = False

If D.Range("A3").CurrentRegion.Rows.Count > 1 Then

  D.Range("A3").CurrentRegion.Offset(1). _

  Resize(D.Range("A3").CurrentRegion.Rows.Count - 1).Clear

End If

If Not IsDate(D.Range("J2")) Or _

 Not IsDate(D.Range("K2")) Then Exit Sub

 Min_date = Application.Min(D.Range("J2:K2"))

 Max_date = Application.Max(D.Range("J2:K2"))

  Ar = Array("E", "F", "G", "H", "I", "J")

For Each Sh In Sheets

    If Sh.Tab.ColorIndex = D.Range("N1") Then

      ReDim Preserve Arr_sh(m)

       Arr_sh(m) = Sh.Name: m = m + 1

     End If

Next Sh

 If m = 0 Then Exit Sub

For m = LBound(Arr_sh) To UBound(Arr_sh)

 D.Cells(K, 1) = Arr_sh(m)

 D.Cells(K + 1, 1) = "Total"

 D.Cells(K + 1, 1).Resize(, UBound(Ar) + 2).Interior.ColorIndex = 20

 K = K + 2

Next m



My_ro = 3

For m = LBound(Arr_sh) To UBound(Arr_sh)

  Set Sh = Sheets(Arr_sh(m))

  Sh.Range("A5:J20000").Interior.ColorIndex = xlNone

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

   For K = LBound(Ar) To UBound(Ar)

        t = K + 2

        For x = 4 To ro

            If Sh.Cells(x, 1) <= Max_date _

            And Sh.Cells(x, 1) >= Min_date Then

              If Val(Sh.Cells(x, Ar(K))) <> 0 Then

                Sh.Cells(x, Ar(K)).Interior.ColorIndex = 6

                my_sum = my_sum + Sh.Cells(x, Ar(K))

              End If

            End If

        Next x

        D.Cells(My_ro, t) = my_sum

        my_sum = 0

   Next K

   My_ro = My_ro + 2

Next m

D.Cells(My_ro, 1) = "Sum Of All"

Rem D.Cells(My_ro - 1, 2).Resize(, UBound(Ar) + 1) = Ar

    With D.Cells(My_ro - 1, 2).Resize(, 6)

      .Value = D.Cells(1, 2).Resize(, 6).Value

      .Interior.Color = vbBlue

      .Font.Color = vbWhite

    End With

D.Cells(My_ro, 2).Resize(, UBound(Ar) + 1).Formula = _

"=Sum(B3:B" & My_ro - 2 & ")"

D.Cells(My_ro, 1).Resize(, UBound(Ar) + 2).Interior.ColorIndex = 6



If D.Range("A3").CurrentRegion.Rows.Count > 1 Then

   With D.Range("A3").CurrentRegion.Offset(1). _

     Resize(D.Range("A3").CurrentRegion.Rows.Count - 1)

    .Borders.LineStyle = 1: .Font.Size = 14

    .Font.Bold = True: .HorizontalAlignment = xlCenter

    .Value = .Value

   End With

End If

 For m = My_ro - 2 To 3 Step -1

  If D.Cells(m, 1) = "Total" And Application.Sum(D.Cells(m, 2).Resize(, 6)) = 0 Then

  D.Cells(m, 1).EntireRow.Hidden = True

  End If

 Next

End Sub

'++++++++++++++++++++++++++++++

Sub show_all()

Sheets("DataReport").Rows.Hidden = False

End Sub