تعديل على كود ترحيل الى جدول

[مهند الزيدي]

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

المطلوب داخل المرفق ..تعديل كود ترحيل من صفحة الى جدول حسب إسم الجدول.. وفقكم الله

جدول إجور.rar

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

أخي الكريم مهند الزيدي

أعتقد أن الكود لي تقريباً والكود يعمل بشكل جيد

المشكلة في المدخلات وليست في الكود ...حيث أنه في الخلية A10 يوجد البيان "مراقبة" وهو ليس ضمن الجدول الموجود في ورقة العمل أجور الطبيب

جرب تغير كلمة مراقبة إلى كلمة "الكبرى" مثلاً ..ستجد أنه لا مشكلة في تنفيذ الكود ..

أرجو أن يكون ذلك حل للمشكلة

عموماً جرب التعديل التالي عله يفي بالغرض

Sub TarhilData()
    Dim WS As Worksheet, SH As Worksheet
    Dim X As Long, Y As Long, Cell As Range
    Dim lRow As Long
    Set WS = Sheets("البيانات"): Set SH = Sheets("أجور الطبيب")
    Application.ScreenUpdating = False
        For Each Cell In WS.Range("P2:p11")
            If Not IsEmpty(Cell) Then
                X = Application.WorksheetFunction.Match(Cell.Value, SH.Rows(1), 0)
                lRow = SH.Cells(49, X).End(xlUp).Row + 1
                
                WS.Range(Cell.Offset(, -14), Cell.Offset(, -12)).Copy
                SH.Cells(lRow, X).PasteSpecial xlPasteValues
                Cell.Offset(, 12).Copy
                SH.Cells(lRow, X + 8).PasteSpecial xlPasteValues
                
                On Error Resume Next
                    Y = Application.WorksheetFunction.Match(Cell.Offset(, -15), Range(SH.Cells(2, X), SH.Cells(2, X + 8)), 0)
                    SH.Cells(lRow, X + Y - 1).Value = Cell.Offset(, -1).Value
                On Error GoTo 0
            End If
        Next Cell
        Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

 

[مهند الزيدي]

شكرا لك اخي "ياسر " وفقك الله لكل خير ... 

ممكن عند إضافة بيانات أو تعديل عدم تكرار الترحيل للبياتات الغير متغيرة عند الضغط على زر الترحيل .. حيث أن عند ترحيل البيانات الجديدة يتم الترحيل مرة إخرى وهكذا تتكرر العملية دائما ..وكذلك ممكن شرح الكود لأنني لا زلت مستجدا على هذه الإمور.... مع الشكر

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

أخي الكريم

يمكنك لكي تتلافي تكرار الترحيل أن تقوم بمسح النطاق في ورقة النتائج قبل بدء الترحيل باستخدام Clearcontents ..

بالنسبة للشرح يحتاج لوقت وأنا منشغل الآن .. قم بدراسة الكود جبداً وحاول أن تفهم الخطوات وإذا لم تدرك خطوة أو سطر أو جزئية قم بطرحها لنشرحها لك إن شاء الله

[مهند الزيدي]

ولو اكون قد أثقلت عليك أخي " ياسر " .. ممكن تعديل كود  ضمن الملف المرفق أيضا ترحيل ولكن لصفحة إخرى تحتوي جدول .. مع تقديري

جدول إجور2.rar

تم تعديل ديسمبر 25, 2015 بواسطه مهند الزيدي

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

لما لا تطرح موضوع جديد بالطلب الجديد أخي الكريم مهند

الأفضل طرح موضوع جديد لكي تجد الاستجابة من الجميع ..

تقبل وافر تقديري واحترامي