ترحيل من صفحة الى عدة صحفات

[elsedik]

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

مرفق ملف

الموردين.rar

[عبدالله المجرب]

جرب هذا الكود

Sub Abu_Ahmed_Trheel()

For i = 1 To Sheets.Count

For T = 8 To [A1000].End(xlUp).Row

If Sheets(i).Name = Cells(T, 1) Then

LR = Sheets(i).[B1000].End(xlUp).Row + 1

Sheets(i).Cells(LR, 2) = Cells(T, 1).Offset(0, 1)

Sheets(i).Cells(LR, 3) = Cells(T, 1).Offset(0, 2)

Sheets(i).Cells(LR, 5) = Cells(T, 1).Offset(0, 3)

Sheets(i).Cells(LR, 6) = Cells(T, 1).Offset(0, 4)

Sheets(i).Cells(LR, 7) = Cells(T, 1).Offset(0, 5)

Sheets(i).Cells(LR, 8) = Cells(T, 1).Offset(0, 6)

End If

Next

Next

End Sub

[رجب جاويش]

أخى الفاضل / عبد الله المجرب

بارك الله فيك

وزادك الله علما وابداعا

[elsedik]

اخى الفاضل عبد الله جزاك الله كل خير

ولكن عند تسجيل عملية دائنة يتم التسجيل اما فى حالة تسيجل عملية مدينة تم مسح العملية السابقة

وشكرا

[عبدالله باقشير]

السلام عليكم

جرب هذا

Sub kh_Trheel()

Dim tShName As String

Dim sh As Worksheet

Dim r%, ii%

For r = 8 To 20

    tShName = "'" & CStr(Cells(r, 1)) & "'!A1"

    '  هذا الشرط يعمل اختبار لصحة اسم الورقة

    If TypeName(Evaluate(tShName)) = "Range" Then

        Set sh = Sheets(CStr(Cells(r, 1)))

        With sh

            ii = .[E1000].End(xlUp).Row + 1

            .Range("B" & ii).Resize(1, 2).Value = Range("B" & r).Resize(1, 2).Value

            .Range("E" & ii).Resize(1, 4).Value = Range("D" & r).Resize(1, 4).Value

        End With

    End If

Next

Set sh = Nothing

End Sub

[رجب جاويش]

أستاذى الفاضل / عبد الله باقشير حفظه الله

بارك الله فيك وزادك علما وابداعا

لى عند حضرتك طلب بسيط

وهو شرح هذين السطرين

tShName = "'" & CStr(Cells(r, 1)) & "'!A1"

	 ' هذا الشرط يعمل اختبار لصحة اسم الورقة

	 If TypeName(Evaluate(tShName)) = "Range" Then

وخاصة ما سبب وجود A1 فى السطر الأول

وسبب وجود كلمة range فى السطر الثانى الخاص باختبار صحة اسم الورقة

مع خالص تحياتى لأستاذى الحبيب

[elsedik]

السلام عليكم

شرف كبير ليا للقيام الاستاذ عبد الله باقشير والاستاذ عبد الله المجرب بالرد على الموضوع

والمشاركة من اخى الفاضل رجب جاويش

وممكن طلب من أ عبد الله باقشير شرح الكود وجزاكم الله كل خير

[أبو أنس حاجب]

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

أستاذي وسيدي الفاضل عبد الله باقشير (أبا علي - خبور خير) حفظك الله وأعزك وأكرم مدخلك في الجنة.

بارك الله فيك وبك وبذريتك من بعدك إلى يوم القيامة.

أحترامي وتقديري ودعائي موصول للأساتذة الأفاضل عبد الله المجرب ورجب جاويش حفظهم الله وجميع أعضاء المنتدى.

أبو أنس ناصر حاجب

[عبدالله باقشير]

أستاذى الفاضل / عبد الله باقشير حفظه الله

بارك الله فيك وزادك علما وابداعا

لى عند حضرتك طلب بسيط

وهو شرح هذين السطرين

tShName = "'" & CStr(Cells(r, 1)) & "'!A1"

	 ' هذا الشرط يعمل اختبار لصحة اسم الورقة

	 If TypeName(Evaluate(tShName)) = "Range" Then

وخاصة ما سبب وجود A1 فى السطر الأول وسبب وجود كلمة range فى السطر الثانى الخاص باختبار صحة اسم الورقة مع خالص تحياتى لأستاذى الحبيب

اخي وحبيبي في الله رجب حفظه الله A1 هي range صح نحن نعمل معادلة وهمية Evaluate مربوطة باسم الورقة مثلا

=Sheet4!$A$1

اذا كان اسم الورقة هذا صحيح

نتيجة TypeName

range

اذا كان غير صحيح

Error

وبهذ نعرف اسم الورقة هذا صحيح ام لا

لان عملية الفحص لاسماء الاوراق بفور نكس

لكل قيد

وخاصة اذا كان معاك اوراق كثير

مرهقة للكود

تقبل تحياتي وشكري

لحرصك على التعلم

[عبدالله باقشير]

السلام عليكم

الاخ الفاضل / elsedik ------------- حفظه الله

لقد تم الشرح اعلاه

والباقي عبارة عن قيود نقل بيانات

بالتساوي بنفس مقاسات الاعمدة والصفوف

.

Range("B" & ii).Resize(1, 2).Value = Range("B" & r).Resize(1, 2).Value

            .Range("E" & ii).Resize(1, 4).Value = Range("D" & r).Resize(1, 4).Value

الاخ الفاضل / أبو أنس حاجب -----------حفظه الله

جزاك الله خيرا وبارك فيك

واثابك بدعائك واعطاك بمثله اضعاف مضاعفة

تقبلا تحياتي وشكري

[رجب جاويش]

أستاذى الحبيب / عبد الله باقشير حفظه الله

الله الله الله

ابداعات مميزة لا تراها ولا تخرج أبدا الا من عالم جليل مثل عالمنا الكبير الأستاذ / عبد الله باقشير

أدام الله عليك نعمة الابداع وزادك من العلم حتى ترضى

تقبل أجمل وأرق تحياتى على هذا الشرح الواضح

تلميذكم / رجب جاويش

[مهند 2002]

الاخوة الكرماء

لماذا اذا كان اسم الورقة عبارة عن رقم ( اسم العمبل رقم ) لماذا لايتم ترحيل البيانات

وهل بالامكان اضاافة اسم العميل + رقم العميل عند اضافة عميل جديد

اشكركم

[أبو أنس حاجب]

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

أستاذي وسيدي الفاضل عبد الله باقشير حفظك الله

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

هل ممكن معالجة ذلك بالكود.

أبو أنس

[MAHMOUD ALI YOUSSEF]

استاذنا الكبير خبور خير

كود اكثر من رائع

جزاك الله كل خير