كود ترحيل واستدعاء من صفحة لعدة صفحات

[abouelhassan]

الاساتذة الاخوة  الخبراء احبائى الاعزاء

نظرا لاننى اقوم بتصميم شيت الاكسيل المبرمج الخاص بى فطلباتى زائدة اليومين دول سامحونى

رأيت موضوع للعلامة عبدالله بقشير (خبور الخير) اسمه ترحيل الى ماشئت من صفحات

احتاج لتطبيقه

لدى ملف به عدد من الاعمدة

التاريخ والبيان والمبلغ واسم الشيت يختار من ليست و اسم العمود يختار من ليست ولدى مفتاحين واحد ترحيل وواحد استدعاء

احتاج كود الترحيل والاستدعاء مع خالص الشكر

والاحترام والتقدير اخواتى الافاضل الخبراء

 

ترحيل واستدعاء.xlsxFetching info...

[abouelhassan]

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

وهو للاستاذ على محمد على

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

Sub Transfer()
Sheets("Main").Activate
For Each F In Range("e2:E1000")
If F <> "" Then
x = F.Value
Range(F.Offset(0, -4), F.Offset(0, 0)).Copy
LR = Sheets(x).Range("A" & Rows.Count).End(xlUp).Row
Sheets(x).Activate
Range("A" & LR + 1).Select
Selection.PasteSpecial xlPasteValues
End If
Next F
Sheets("Main").Activate
Application.CutCopyMode = False
Range("A2:E1000").ClearContents
MsgBox "تم الترحيل الى كل صفحة بنجاح"
End Sub

 

ترحيل واستدعاء.xlsxFetching info...

[احمد بدره]

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

فقط الكود يحتاج تعديل اسم ورقة العمل فقط

Sub Transfer()

Sheets("ترحيل واستدعاء").Activate
For Each F In Range("e2:E1000")
If F <> "" Then
x = F.Value
Range(F.Offset(0, -4), F.Offset(0, 0)).Copy
LR = Sheets(x).Range("A" & Rows.Count).End(xlUp).Row
Sheets(x).Activate
Range("A" & LR + 1).Select
Selection.PasteSpecial xlPasteValues
End If
Next F
Sheets("ترحيل واستدعاء").Activate
Application.CutCopyMode = False
Range("A2:E1000").ClearContents
MsgBox "تم الترحيل الى كل صفحة بنجاح"
End Sub

 

[a.kawkab]

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

اليك هذا الملف لعله يفى بالغرض

ترحيل واستدعاء.xlsmFetching info...

[احمد بدره]

جرب هذه الفكرة ربما تفي الغرض

وهي أن يتم عمل عمود لكل اسم تريد الترحيل المبلغ فيه

ترحيل واستدعاء.xlsmFetching info...

[abouelhassan]

جميلة استاذى بس المشكلة عمود sheetname يتم نسخه فى الصفحات 

وهذا لايمكن عمله بالصفحات

اشكرك جداااااااااااااااااااااااااااااا استاى الغالى 

انا وجدت من خلال البحث بالمنتدى كود نفذ لى المطلوب بس محتاج تعديل بسيط هو امكانيات اختيار العمود m1 او m2 او

بس نفذ المطلوب يرحل كل المبالغ للعمود m1  اريده ان باختيار العمود يرحل اليه واريد كود استدعاء

الكود هو

Sub Transfer()
Sheets("ترحيل واستدعاء").Activate
For Each F In Range("e3:E27")
If F <> "" Then
X = F.Value
Range(F.Offset(0, -4), F.Offset(0, 0)).Copy
LR = Sheets(X).Range("A" & Rows.Count).End(xlUp).Row
Sheets(X).Activate
Range("A" & LR + 1).Select
Selection.PasteSpecial xlPasteValues
End If
Next F
Sheets("ترحيل واستدعاء").Activate
Application.CutCopyMode = False
Range("b3:f27").ClearContents
MsgBox "تم الترحيل الى كل صفحة بنجاح"
End Sub

كل حبى واحترامى

ترحيل واستدعاء.xlsmFetching info...

[احمد بدره]

تم وضع عمود اسم الشييت في العمود R

جرب هذا

ترحيل واستدعاء.xlsmFetching info...

[احمد بدره]

تم إضافة مسح النطاق من a2 : p27 بعد الترحيل

ترحيل واستدعاء.xlsm 39.8 kB · 87 downloads

[abouelhassan]

بارك الله فيك استاذنا اشكر حضرتك لمجهودك الكريم جدااااااااااا

ولو امكن تعديل المكرو بالملف المرفق 

لاتمكن من اختيار العمود المرحل اليه المبلغ

خالص الشكر والدعاء من القلب والله

ماكرو ترحيل بقائمة منسدلة.xlsm 27.73 kB · 60 downloads

[abouelhassan]

برجاء التكرم بالمساعدة فى المطلوب بالمرفق 

جزاكم الله خير اساتذتى الافاضل

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

اخيك باحترام شديد جدا

ترحيل واستدعاء.xlsxFetching info...