استاذى احمد عبدالناصر
اكواد جميلة وتواضعك اعظم
هناك اضافة بسيطة جدا سرعت الكود
ايقاف الحساب التلقائى لحيت ينفيذ الكود ثم العوده للتلقائى فى النهاية
Sub Button4_Click()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
x = Cells(Rows.Count, 2).End(xlUp).Row
If x > 2 Then
Range("ba3:ba" & x).Formula = "=b3&c3&d3"
y = Cells(Rows.Count, "h").End(xlUp).Row
If y > 2 Then
Range("bb3:bb" & y).Formula = "=h3&i3&j3"
Range("bc3:bc" & x).FormulaR1C1 = "=COUNTIF(C[-1],RC[-2])"
Range("bd3:bd" & y).FormulaR1C1 = "=COUNTIF(C[-3],RC[-2])"
If x > y Then Z = x Else Z = y
Range("ba3:bd" & Z) = Range("ba3:bd" & Z).Value
For i = 3 To Z
If Cells(i, "bc") > 0 Then
Range("a" & i & ":e" & i).Copy Range("n" & n + 3)
Range("a" & i & ":e" & i).ClearContents
n = n + 1
End If
If Cells(i, "bd") > 0 Then
Range("g" & i & ":k" & i).Copy Range("t" & t + 3)
Range("g" & i & ":k" & i).ClearContents
t = t + 1
End If
Next
Range("ba3:bd" & Z).Clear
Range("a3:e" & x).Sort key1:=Range("a3"), key2:=Range("b3")
Range("g3:k" & x).Sort key1:=Range("g3"), key2:=Range("h3")
End If
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub