ترحيل إلى أوراق عمل أخرى حسب شروط معينة

[سعد الفقير]

السلام عليكم .

 

 

 

ارغب في ترحيل بيانات المرتبة (D2)والاسم(G2) من الورقة المسماه SQ مع الترقيم التسلسلي الى الورقة A,B,C,D حسب تخصص الموظف والخلية التي يعمل بها (K2) 

 

مثلا.

 

في الورقة A عندما اختار من البوكس اما أ,ب,ج ينقل لي تخصص مشرف الصيانة حسب الخيار الموجود في البوكس . وهكذا مع االاوراق ل B,C,D حسب التخصصات الاخرى. 

 

شكرا لحسن تعاونكم

 

يوجد ملف مرفق.

V1.rar

[ياسر خليل أبو البراء]

الأخ الكريم سعد

 

مشكور على توضيح طلبك .. ونعتذر إليك إذا كنا قد أرهقناك بكثرة توجيهاتنا

إليك الملف التالي عله يفي بالغرض

Sub SheetA()
    Dim WS As Worksheet, SH As Worksheet
    Dim lRow As Long, Cell As Range
    Set WS = Sheets("SQ"): Set SH = Sheets("A")
    lRow = 28
    Application.ScreenUpdating = False
        For Each SH In Worksheets
            If SH.Name = "A" Or SH.Name = "B" Or SH.Name = "C" Or SH.Name = "D" Then
                SH.Range("B28:J230").ClearContents
                With WS
                    For Each Cell In WS.Range("J2:J" & .Cells(Rows.Count, "J").End(xlUp).Row)
                        If Cell.Value & Cell.Offset(, 1).Value = SH.Range("A27").Value Then
                            SH.Cells(lRow, "B") = lRow - 27
                            SH.Cells(lRow, "C") = Cell.Offset(, -6)
                            SH.Cells(lRow, "D") = Cell.Offset(, -3)
                            lRow = lRow + 1
                        End If
                    Next Cell
                End With
            End If
            lRow = 28
        Next SH
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

Grab Data Based On Conditions.rar

[سعد الفقير]

أحسنت صنعا اخي ياسر . فمنكم نستفيد وبالعكس توجيهاتكم محل اهتمامنا.

 

نعم هذا هو المطلوب . وشكرا لك

[ياسر خليل أبو البراء]

الحمد لله الذي بنعمته تتم الصالحات والحمد لله أن تم المطلوب على خير ..

وتصبح على خير أخي الكريم سعد .. أستودعك الله