السلام عليكم ورحمة الله
كل عام و انتم بخير
الله اعلم ان كنت فهمت ما تريده كما تقصد ام لا
الكود الاول لجلب اسماء العملاء بدون تكرار و يم ربطه بزر التنفيذ
يمكنك التعديل على الكود لاضافة مزيد من الشهور
CODE
Sub GetNames()
Dim ws As Worksheet, Sh As Worksheet
Dim LR As Long, i As Long, C As Range
Dim LS As Long, p As Long, Obj As Object
Set Sh = Sheets("Summary")
LS = Sh.Range("B" & Rows.Count).End(3).Row
Sh.Range("B3:B" & LS) = ""
Set Obj = CreateObject("scripting.dictionary")
For Each ws In Worksheets(Array("January", "February", "March"))
If ws.Name <> Sh.Name Then
LR = ws.Range("B" & Rows.Count).End(3).Row - 1
For Each C In ws.Range("B3:B" & LR)
If Not IsEmpty(C) Then Obj(C & "") = ""
Next
End If
Next
Sh.Range("B3").Resize(Obj.Count, 1) = Application.Transpose(Obj.keys)
Call SumIf_Valus
End Sub
الكود الثانى و هو مربوط بالكود الاول و لا يتم تنفيذه منفردا
CODE
Sub SumIf_Valus()
Dim ws As Worksheet, Sh As Worksheet
Dim LR As Long, i As Long
Dim Arc As Variant, Arr As Variant
Dim LS As Long, j As Long, x As Double
Dim SupNam As String
Application.ScreenUpdating = False
Set Sh = Sheets("Summary")
LS = Sh.Range("B" & Rows.Count).End(3).Row
If LS < 3 Then LS = 3
Arc = Array("D", "E", "F", "G", "H", "I", "J", "K", "L", "M")
Arr = Array("G", "H", "I", "J", "K", "L", "M", "N", "P", "Q")
j = 3
Do While j <= LS
SupNam = Sh.Range("B" & j)
For i = LBound(Arr) To UBound(Arr)
For Each ws In Worksheets(Array("January", "February", "March"))
LR = ws.Range("B" & Rows.Count).End(3).Row
If LR < 3 Then LR = 3
x = x + WorksheetFunction.SumIf(ws.Range("B3:B" & LR), SupNam, _
ws.Range(ws.Cells(3, Arr(i)), ws.Cells(LR, Arr(i))))
Sh.Range(Arc(i) & j) = x
Next
x = 0
Next
j = j + 1
Loop
Application.ScreenUpdating = True
End Sub