اذهب الي المحتوي
أوفيسنا

كيـفـية عمل كود ترحيل البينات من شيت إلى اخر ( مع شرح مبسط )..


إذهب إلى أفضل إجابة Solved by ياسر خليل أبو البراء,

الردود الموصى بها

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

اسعد الله مسائكم 

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

 

qZlO3J.png

 

 

وتقبلو تحياتي

 

 

 

 

DRAFT.rar

post-122807-0-20471500-1432327488_thumb.

تم تعديل بواسطه ياسين ( أبو وسام )
رابط هذا التعليق
شارك

  • أفضل إجابة

أخي الكريم ياسين ابو وسام

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

Sub TransferData()
    Dim WS As Worksheet, SH As Worksheet
    Dim X As Long
    Set WS = Sheets("ترحيل"): Set SH = Sheets("MP LIST")
    X = SH.Cells(Rows.Count, 2).End(3).Row + 1
    Application.ScreenUpdating = False
        With SH
            .Cells(X, 1) = .Cells(X, 1).Row - 2
            .Cells(X, 2).Resize(, 3) = Application.Transpose(WS.Range("G9").Resize(3))
            .Cells(X, 5).Resize(, 7) = Application.Transpose(WS.Range("G14").Resize(7))
            .Cells(X, 12) = WS.Range("G22")
            .Cells(X, 13).Resize(, 5) = Application.Transpose(WS.Range("G24").Resize(5))
            .Cells(X, 18) = WS.Range("I28")
            .Cells(X, 19) = WS.Range("G30")
            .Cells(X, 23) = WS.Range("G32")
            .Cells(X, 27) = WS.Range("G13")
            .Cells(X, 28) = WS.Range("I13")
            .Cells(X, 29) = WS.Range("G44")
            .Cells(X, 30) = WS.Range("H44")
            .Cells(X, 31) = WS.Range("I44")
            .Cells(X, 32) = WS.Range("G47")
            .Cells(X, 33) = WS.Range("H47")
            .Cells(X, 34) = WS.Range("I47")
            .Cells(X, 36).Resize(, 7) = Application.Transpose(WS.Range("G34").Resize(7))
            .Cells(X, 43) = WS.Range("J41")
            .Cells(X, 44) = WS.Range("G49")
        End With
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

Draft Transfer Data.rar

  • Like 2
رابط هذا التعليق
شارك

الاخ الجليل ياسر 

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

كود فوق الممتاز..

 

ويبقى طلب ...... محو السحل بعد الترحيل

سلمت يداك بكل خير

تم تعديل بواسطه ۩◊۩ أبو حنين ۩◊۩
  • Like 1
رابط هذا التعليق
شارك

اخي الحبيب أبو البراء السلام عليكم ورحمة الله وبركانه

 

اسعد الله ايامك واتمها بالخير وجعل الله هذا العمل في ميزان حسناتك

 

وهذا العمل ماكنت اريده وهو رائع وقمة في الابداع وكنت انتظر مشاركتك بفارغ الصبر للانني أحبك بالله  :biggrin2: 

 

والأن أود بعض التعديل وانا اعلم انك لن تتأخرعن مساعدتي

  • محو السحل بعد الترحيل.
  • اظهار مسج خطئ حين لا يتم تعبئة كامل المعلومات .
  • مسج اخر عند تعبئة الخلايا بشكل كامل " تم الترحيل ".
  • في حال تم ادراج رقم الموظف في السابق لايتم عملية الترحيل ويظهر مسج " الرجاء التحقق من رقم الموظف ".

 

 

وتقبل تحياتي

  • Like 1
رابط هذا التعليق
شارك

أخي الحبيب ياسين

ترهقني الطلبات الكثيرة في الموضوع الواحد

قم بطرح موضوع جديد فيه الطلبات الجديدة وإن شاء الله جهزت لك الحل

ولا تنسى أن تغلق الموضوع بتحديد أفضل إجابة ليظهر الموضوع مجاب ومنتهي

اعذرني إن كنت أثقل عليك

تقبل تحياتي

  • Like 1
رابط هذا التعليق
شارك

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

تم تحديد افضل اجابة لأنك الأفضل وانت غالي اخي ابو البراء وشكرا على المجهود الذي بذلته

سوف اقوم بتحضير موضوع اخر باذن الله

وتقبل تحياتي 

  • Like 1
رابط هذا التعليق
شارك

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

  • Like 1
رابط هذا التعليق
شارك

الأخ الحبيب أبو يوسف

بارك الله فيك وجزيت خيراً على كلماتك الطيبة

هناك موضوع للأخ ياسين استكمالاً لهذا الموضوع على هذا الرابط ..إن شاء الله يكون فيه فايدة أكبر

http://www.officena.net/ib/index.php?showtopic=61626

تقبل تحياتي

  • Like 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information