كود جلب اسماء العملاء الموجودين حصرا في شيت (اقساط) واخر تسديد

Sub Grab_Last_Date()

    Dim ws          As Worksheet

    Dim sh          As Worksheet

    Dim arr         As Variant

    Dim temp        As Variant

    Dim x           As Variant

    Dim i           As Long

    Dim j           As Long

    Dim k           As Long

    

    Set ws = Sheets("اقساط")

    Set sh = Sheets("تاريخ")

    arr = sh.Range("B2:B" & sh.Cells(Rows.Count, 1).End(xlUp).Row).Value

    ReDim temp(1 To UBound(arr, 1))

    k = 0

    

    Application.ScreenUpdating = False

        For i = LBound(arr, 1) To UBound(arr, 1)

            k = k + 1

            x = Application.Match(CStr(arr(i, 1)), ws.Columns(7), 0)

            If IsNumeric(x) Then

                For j = 10 To 23 Step 2

                    If ws.Cells(x, 10) = "" Then GoTo Skipper

                    If ws.Cells(x, j) = "" Then temp(k) = ws.Cells(x, j - 1): GoTo Skipper

                Next j

            Else

                temp(k) = ""

            End If

Skipper:

        Next i

    

        sh.Range("F2").Resize(k).Value = Application.Transpose(temp)

    Application.ScreenUpdating = True

End Sub