محتاجة مساعدة صممت فورم ترحيل محتاج كتابة الكود

[omhamzh]

الاساتذة الافاضل المحترمين

تحية وتقدير

احتاج مساعدة فى كتابة كود لفورم الترحيل الذى صممته للمساعدة فى سرعة العمل

لدى عدد25 شيت كلهم زى بعض بكل منهم عدد30 عمود ارحل بيانات اليهم

صممت فوم لاقوم باختيار الشيت الذى اريد الترحيل اليه و واكتب المبلغ واختار العمود المراد الترحيل اليه فيترحل

واترحم من التنقل من شيت الى شيت ومن عمود الى عمود

كتبت بعض النتائج المرفغوب الحصول عليها 

وبعد كده احاول اعدل الكود للبيانات الكاملة

برجاء التكرم بمساعدتى

خالص الدعاء لكم من قلبى 

ترحيل تست1.xlsb

تم تعديل نوفمبر 6, 2020 بواسطه omhamzh

[سليم حاصبيا]

1- هناك خطأ فب تصميم اليوزر

   قمت بتسمبة المبلغ في ListBox  والمفروض TextBox   كما في الصورة
2-  ما هي أرقام الأعمدة (1  2    3....الخ) أو أسمائها (  AB    M    B    A   الخ....) من بين 30 عامود فهل تريدين ان نفتش عنها

 

[omhamzh]

انا ضعيفة فى الاكسيل فورم

السماح والمعذرة

اما الاعمدة المراد الترحيل اليها سميتها محمد1 محمد 2 محمد 3 وهكذا

مع التقدير لك استاذ عظيم من عظماء المنتدى الكبير

 

[سليم حاصبيا]

أظن اته لا حاجة الى اليوزر و مشاكله اذا استعملتي هذا النموذج
1- أضيفي الى الشبت ما تريدين من الأعمدة مع عناويتها
2- تعبئة البيانات في الصفحة  Main (يمكن تعبئة صف واحد أو عدة صفوف دفعة واحدة ) ليس كما في اليوزر
3- تحددين الورقة التي سيتم الترحيل اليها من الصفحة  Main ( القائمة المنسدلة الحمراء)

4- تضغطين على الزر Run

الكود
 

Option Explicit

Sub transfere_data()
  Dim M As Worksheet
  Dim sh As Worksheet
  Dim Rg As Range
  Dim ALL_Rg As Range
  Dim Max_ro%

  Set M = Sheets("Main")
  If M.Range("G2") = vbNullString Then Exit Sub
  Set sh = Sheets(M.Range("G2") & "")

Max_ro = sh.Cells(Rows.Count, 2).End(3).Row + 1
If Max_ro <= 3 Then Max_ro = 4
Set Rg = M.Range("B3").CurrentRegion
If Rg.Rows.Count = 1 Then Exit Sub
Set Rg = Rg.Offset(1).Resize(Rg.Rows.Count - 1)
Rg.Copy
sh.Cells(Max_ro, 2).PasteSpecial (12)
Set ALL_Rg = sh.Range("B3").CurrentRegion
If ALL_Rg.Rows.Count > 1 Then
 sh.Range("A4").Resize(ALL_Rg.Rows.Count - 1) = _
 Evaluate("row(1:" & ALL_Rg.Rows.Count - 1 & ")")
End If
Application.CutCopyMode = False

End Sub

الملف مرفق

Omhamza.xlsm

[سليم حاصبيا]

لا يهمني ما يوجد في العامود  (المطلوب اسمه و رقمه)

[omhamzh]

ما هو الاعمدة الى انا اريد الترحيل اليها الى فى الشيت انا كاتبة اسمه محمد1 محمد 2

عملت كل مبلغ جنب العمود المراد ارحل اليه وياريت اختيار من كومبو بوكس واختار ترحيل فيترحل كل مبلغ الى العمود المسمى محمد1 او محمد 2 او محمد3

حسب من اختارت 

مع تقديرى ودعائى لسعادتك اخى

[سليم حاصبيا]

ليس عملي ان أبحث عن محمد 1 أو محمد 2 الخ... كي اكتشف في اي عامود موجودين كي اضع رقم هذا العامود في الكود

قدمت لك نموذج ابسط بكثير من اليوزر للعمل عليه  ولا أعرف لماذا هذا الاصرار على اليوزر مع اني لا أطيقه ولا أحب العمل عليه فكيف كي ان اضع  فيه اكثر من 40 كود (20 للتكست بوكسات و 20 للكومبوبوكسات) بالاضاقة الى أكواد الأزرار

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

[omhamzh]

كمان معلش الشيت الترحسل بيرحل كل شئ بالصفحة يعنى حتى اسم الشيت المختار بيترحل 

انا عملت صفحة فارغة مثل الشيتات بالضبط

ونقلت الكود تمام واكتب واختار اسم الشيت واضغط يترحل بس مش فى اماكنه

اريد الترحيل يبدأ من الخليةA3 

وعند المسح لشيت Main والكتابة اجد انه

رحل اسماء الاعمدة مرة اخرى 

مع خالص الدعاء بالتوفيق الدائم ان شاء الله حفظك الله

تم تعديل نوفمبر 6, 2020 بواسطه omhamzh

[سليم حاصبيا]

اين الملف للعمل عليه؟؟؟ وهل تريدين ان تمسح البيانات من الشيب Main  يعد الترحيل؟؟

[omhamzh]

ها هو اخى كل ما ابغاه باى طريقة مش مهم فورم او شيت انا عايزة اسرع طريقة ادخال وترحيل اختار الشيت للترحيل اكتب المراد ترحيله

ثم يتم افراغ شيت main لاعادة الكتابة مرة اخرى

لانى افضل طول اليوم اتنقل من شيت الى شيت الى شيت حوالى 19 شيت

مع المعذرة والدعاء والله لك من قلبى

ترحيل تست1.xlsb

[سليم حاصبيا]

جربي هذا الملف

لا ضرورة لادراج التسلسل لان الكود يدرجه اوتوماتيكياُ في كل صفحة جسب احر رقم موجود فيها

الأعمدة التي تحتوي على مغادلات تم اخفائها  (في الشيت Main  فقط) لعدم العبث بها عن طريق الخطأ أثناء كتابة  البيانات
    (المعادلات محمية ضد الكتابة عليها)

       المعادلات في الشيت Main  فقط الماكرو يقوم بنقل قيمها فقط الى الشيت التي اخترتها) 
                   لذلك لا حاجة لادراحها في كل شيت

لا تقومي بحذف البيانات (من خلال تجدديد الصف بأكمله تم  Delete )لأن ذلك يمسح المعادلات في الأعمدة التي تحتويها (H,Y,AM.AN)
تم التعديل على المعادلات لعدم ادراج الأصفار والأخطاء

يمكنك تصحيح الاخطاء في الخلايا التي لا تحتوي على معادلات  /// كل الأعمدة ما عدا (H,Y,AM.AN) ////
   هذه الاعمدة مخفية  لا تعملي Select يمس بها ثم Delete )
                         الزر  Clear data  يمسح كل شيء ما عدا المعادلات
                                             يمكن استعماله متى تريدين

الملف مرفق

ي

Om_hamza.xlsb

[omhamzh]

الله يرضى عنك وعن ال بيتك اجمعين

هذا المطلوب واكثر والله

اكثر الله خيرك وبارك الله فيك وبك اخى

الف شكر لحضرتك حفظك ورعاك رب العالمين