المساعده في تعديل الكود

[toyota]

برجاء المساعده في تعديل كود الترحيل التالي حيث انه يقوم بإنشاء صفحه فارغه بعد كل عمليه ترحيل 

 ----------------------------------------------------------

Sub ragab()

Dim cl As Range, sh As Worksheet

Application.ScreenUpdating = False

For Each sh In ThisWorkbook.Worksheets

If Not sh.Name = "Sheet1" Then

sh.Range("A1:G1000").ClearContents

End If

Next

LR = Cells(Rows.Count, 2).End(xlUp).Row

For Each cl In Range("B2:B" & LR)

x = Trim(cl.Value)

On Error Resume Next

If Worksheets(x) Is Nothing Then

Sheets.Add.Name = x

Sheets(x).Move After:=Sheets(Sheets.Count)

End If

Sheets("sheet1").Range("A1:f1").Copy

Sheets(x).Range("A2").PasteSpecial xlPasteValues

Sheets(x).Range("A2").PasteSpecial xlPasteFormats

cl.Offset(0, -1).Resize(1, 6).Copy

Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial xlPasteValues

Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row, 1).PasteSpecial xlPasteFormats

Sheets(x).Cells(Sheets(x).Cells(Rows.Count, 1).End(xlUp).Row, 1).PasteSpecial xlPasteColumnWidths

Application.CutCopyMode = False

Next

MsgBox "تم الترحيل بنجاح"

Sheets("sheet1").Select

Application.ScreenUpdating = False

End Sub

---------------------------------------------------------------------------

ومرفق معه الملف المراد التعديل عليه 

 

office.zip

[ibn_egypt]

أخى الفاضل

 

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

 

الكود سليم مليووووووووووووووووون في الميه ولا توجد به أى أخطاء 

 

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

 

هات ودنك    ... روح للخلية B904 في Sheet1 انت مش كاتب فيها اى كود "" فاضية "" فالكود بيعملك صفحة فاضية يعني الراجل عداه العيب انت اللى غلطان مش هو   

 

اكتب الكود الخاص بها .. ولن يتم انشاء اى صفحات فارغة

 

تحياتي  

[سلمان المجذوب]

رووووووووعه الورقة بتاعك ياعم...ساستفيد منها الكثير الكثير..

بس عندي سؤال..ليش لما اضغط على ارباح وخسائر او صافي الصندوق ..بيطلع لي خطاء

ارجو الرد وشكرا

تم تعديل نوفمبر 28, 2014 بواسطه سلمان المجذوب

[سلمان المجذوب]

تم تعديل نوفمبر 28, 2014 بواسطه سلمان المجذوب

[toyota]

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

الاخوة الافاضل الاخ  ibn_egypt  شكرا لكم علي سرعه الرد والاهتمام بالموضوع 

ولكن توجد هناك مشكله اخري كنت اعتقد ان ظهور الصفحات الفارغه هو سببها 

المشكله هي : انه عند اضافه اي شيت بالطريقه اليدويه ووضع بها اي  بيانات وبعد ذلك اقوم بعمليه الترحليه اجد الصفحه المضافه خاليه تماما من اي بيانات  ارجوا المساعده في هذه المشكله وجزاكم الله خيرا 

[سلمان المجذوب]

انت ليش تضيف ورقة جديده يدويا

اذا ودك تضيف ورقة جديده روح على اليومية

عمود الكود

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

وسوي ترحيل

بيفتح لك ورقة جديده ويرحل اليه البيانات الخاصة بها تلقائيا

[toyota]

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

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

هناك احد الاصدقاءقام بالتعديل علي الكود لهذا الغرض ولكن للاسف اصلح شئ واتلف شئ اخر 

حيث انه قام بتنفيذ المطلوب وهواضافه ورقه جديد وعمل ترحيل دون المساس بهذه الورقه ولكن في المقابل عمليه الترحيل لم تعمل بالشكل المطلوب حيث ان الترحيل اصبح يكرر الصفوف 

تم تعديل نوفمبر 28, 2014 بواسطه toyota

[ابو لؤي2013]

احسن واحد يعملك الي بدك

هو الاخ الفاضل احمد

هذا  ibn_egypt

[ibn_egypt]

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

الاخوة الافاضل الاخ  ibn_egypt  شكرا لكم علي سرعه الرد والاهتمام بالموضوع 

ولكن توجد هناك مشكله اخري كنت اعتقد ان ظهور الصفحات الفارغه هو سببها 

المشكله هي : انه عند اضافه اي شيت بالطريقه اليدويه ووضع بها اي  بيانات وبعد ذلك اقوم بعمليه الترحليه اجد الصفحه المضافه خاليه تماما من اي بيانات  ارجوا المساعده في هذه المشكله وجزاكم الله خيرا 

 

أخى الفاضل

 

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

 

تفضل الملف المرفق، تم التعديل في الكود ليناسب طلبك فلن يتم مسح اى بيانات من الورقة المضافة يدويا بشرط ان يكون اسمها ليس بنفس اسم اى رقم من الأكواد المكتوبة في Sheet1

 

تحياتي  

office.rar

[toyota]

عزيزي الغالي 

ibn_egypt

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

اثقلت عليك بطلباتي ولكن منكم نستفيد 

لدي ملاحظة يمكن ان تفيد وهي 

اذا قمنا بإقاف السطر 'sh.Range("A1:G1000").ClearContents

يتم الترحيل بصورة سليمه وايضا عمليه مسح البيانات من الشيتات المضافه انهت ولكن اذا قمت بعمل ترحيل مرة اخري فانه يقوم بتكرار البيانات جميعها 

ارجوا ان تكون ملحوظه مفيده 

ولك جزيل الشكر 

تم تعديل نوفمبر 28, 2014 بواسطه toyota

[ibn_egypt]

أخى الفاضل

 

فعلا انت عندك حق انا اللى اخطأت، كنت لسه قايم من النوم معلش  

 

جرب المرفق

 

تحياتي  

office.rar

[toyota]

اخي الكريم 

ibn_egypt

اشكرك جزيل الشكر علي تعاونك معي جعله الله في ميزان حسناتك 

[ibn_egypt]

اخي الكريم 

ibn_egypt

اشكرك جزيل الشكر علي تعاونك معي جعله الله في ميزان حسناتك 

 

أخى الفاضل

 

لا شكر على واجب أرجو ان يكون عملك الآن على ما يرام

 

لاتنسانا من دعواتك بظهر الغيب

 

تحياتي  

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

جزاكم الله خير الجزاء يا ابن مصر ..

نشاط منقطع النظير .أسلوب مميز .. من شخص رائع

ومساعدة لللجميع بلا استثناء .

بارك الله فيك .. تقبل تحياتي وحبي وأشواقي (اوعى المدم تقرا الكلام ده لتغير مني)