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

[ياسين ( أبو وسام )]

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

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

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

 

 

 

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

 

 

 

 

DRAFT.rar

تم تعديل مايو 22, 2015 بواسطه ياسين ( أبو وسام )

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

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

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

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

[۩◊۩ أبو حنين ۩◊۩]

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

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

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

 

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

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

تم تعديل مايو 23, 2015 بواسطه ۩◊۩ أبو حنين ۩◊۩

[ياسين ( أبو وسام )]

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

 

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

 

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

 

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

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

 

 

وتقبل تحياتي

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

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

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

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

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

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

تقبل تحياتي

[ياسين ( أبو وسام )]

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

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

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

وتقبل تحياتي 

[محمد حسن المحمد]

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

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

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

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

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

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

تقبل تحياتي