احضار بيانات

[محمود رواس]

السلام عليكم ورحمة الله وبركاته

برجاء المساعدة في الشيت المرسل حيث انني ارغب عند كتابه اسم الشركة في الشيت 2 يتم جلب البيانات المطلوبه من الشيت الاساسي ولو كانت اكثر من صف يتم اضافتها جميعا كل صف على حدة ارجو ان يكون الطلب واضح 

وشكرا 

Bank Cheque.xlsx

[Mohamed_Fouad]

و عليكم السلام و رحمة الله 

تفضل اخى الكريم اتمنى ان يكون هذا هو طلبك

 

Bank Cheque.xlsx

[حسين مامون]

بعد اذن الاستاذMohamed_Fouad 

واثراء للموضوع 

جرب المرفق

 

Bank Cheque.xlsm

[Ali Mohamed Ali]

وبعد اذن جميع الأساتذة وزيادة فى اثراء الموضوع-تفضل

 

 

Bank Cheque.xlsm

[محي الدين ابو البشر]

Sub test()
    Dim a As Variant, lr, i, x, s, k, itm
    Dim bch As Worksheet
    Set bch = Sheets("Bank Cheque")
    lr = bch.Cells(Rows.Count, "a").End(xlUp).Row - 1
    a = Application.Index(bch.Cells(2, 2).Resize(lr, 21).Value, Application.Evaluate("row(1:" & lr & ")"), Array(1, 2, 6, 7, 8, 13, 16, 20))
    With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
            If bch.Cells(i + 1, 4) = Sheets("Sheet4").Range("d3") And bch.Cells(i, 4) <> "" Then
                If Not .exists(Cells(i + 1, 4)) Then
                    .Add bch.Cells(i + 1, 4), a(i, 1) & Chr(162) & a(i, 2) & Chr(162) & a(i, 3) & Chr(162) & a(i, 4) & Chr(162) & a(i, 5) & Chr(162) & a(i, 6) & Chr(162) & a(i, 7) & Chr(162) & a(i, 8)
                Else
                    .Item(bch.Cells(i + 1, 4)) = .Item(Cells(i + 1, 4)) & Chr(162) & a(i, 1) & Chr(162) & a(i, 2) & Chr(162) & a(i, 3) & Chr(162) & a(i, 4) & Chr(162) & a(i, 5) & Chr(162) & a(i, 6) & Chr(162) & a(i, 7) & Chr(162) & a(i, 8)
                End If
            End If
        Next
        k = .keys
        itm = .items
        Ct = .Count
        With Sheets("Sheet4")
            Range("a8:f10000").ClearContents
            For i = 1 To Ct
                x = Split(itm(i - 1), Chr(162))
                .Range("a" & 8 + i - 1).Resize(, UBound(x) + 1) = x
            Next
        End With
    End With
End Sub

اسم الشركة فيD3

[محمود رواس]

يعجز اللسان عن شكركم جميعا 

[أحمد يوسف]

استاذ

محمود رواس

كل ده تمام ولكن اين الضغط على الإعجاب ؟

على الرغم ان هذا هو أقل ما يقدم لهم على كل ما قدموه لك