السلام عليكم ورحمة الله وبركاته
هل من الممكن المساعدة من الاخوة والزملاء فى المنتدي مساعدتى فى تصحيح اخطاء الكود
ملاحظة : الكود يعمل بشكل سليم ولكن بطيئ جدا فى استدعاء البيانات
ولكم وافر الشكر والتقدير
Private Sub CommandButton1_Click()
Dim WB As Workbook
Dim SH As Worksheet
Dim SH2 As Worksheet
Dim SH3 As Worksheet
Dim SH4 As Worksheet
Set WB = ThisWorkbook
Set SH = WB.Sheets("CUT")
Set SH2 = WB.Sheets("POLISH")
Set SH3 = WB.Sheets("AR_ST")
Set SH4 = WB.Sheets("AR_PAID")
Application.ScreenUpdating = False
Range("AR_ST").ClearContents
LR = SH.Range("D100000").End(xlUp).Row
LR1 = SH3.Range("B100000").End(xlUp).Row + 1
LR2 = SH2.Range("E100000").End(xlUp).Row
LR5 = SH4.Range("B100000").End(xlUp).Row
X = LR1
For i = 4 To LR
If SH3.Cells(2, "b") = SH.Cells(i, "D") And SH.Cells(i, "ac") <> "0" Then
SH3.Cells(X, "b") = SH.Cells(i, "O")
SH3.Cells(X, "c") = SH.Cells(i, "F")
SH3.Cells(X, "d") = SH.Cells(i, "G")
SH3.Cells(X, "e") = SH.Cells(i, "P")
SH3.Cells(X, "F") = SH.Cells(i, "AC")
X = X + 1
End If
Next i
LR3 = SH3.Range("B100000").End(xlUp).Row + 1
N = LR3
For Q = 4 To LR2
If SH3.Cells(2, "b") = SH2.Cells(Q, "E") Then
SH3.Cells(N, "B") = SH2.Cells(Q, "B")
SH3.Cells(N, "G") = SH2.Cells(Q, "C")
SH3.Cells(N, "H") = SH2.Cells(Q, "D")
SH3.Cells(N, "I") = SH2.Cells(Q, "G")
SH3.Cells(N, "J") = SH2.Cells(Q, "L")
SH3.Cells(N, "K") = SH2.Cells(Q, "P")
N = N + 1
End If
Next Q
LR4 = SH3.Range("B100000").End(xlUp).Row + 1
T = LR4
For U = 4 To LR5
If SH3.Cells(2, "b") = SH4.Cells(U, "C") Then
SH3.Cells(T, "B") = SH4.Cells(U, "B")
SH3.Cells(T, "L") = SH4.Cells(U, "F")
SH3.Cells(T, "M") = SH4.Cells(U, "G")
T = T + 1
End If
Next U
lr6 = SH3.Range("B100000").End(xlUp).Row
Dim rng As Range
Set rng = SH3.Range(SH3.Cells(lr6, "b"), SH3.Cells(4, "m"))
rng.Select
Application.ScreenUpdating = True
End Sub
