اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

السلام عليكم

يوجد عندى ملف يحتوى على عدد من أوراق العمل

بعضها يحتوى على بيانات مفصلة والبعض الاّخر يحتوى على إجماليات

لهذه البيانات

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

بيانات هذه الزيوت إسمها إجماليات الزيوت

ما أريده يا إخوانى

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

يتم نسخ الأعمدة الثلاثة الأولى والعمود الخامس كذلك من الورقة إلى مصنف جديد يتم إنشاؤه عن طريق هذا الكود

مع تسمية ورقة العمل فى المصنف الجديد التى تم اللصق فيها

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

أى فى مثالنا هنا توجد ورقة بإسم إجمالى الزيوت يتم إنشاء مصنف جديد وليكن إسمه

(إجماليات) وننسخ الأعمدة كما أشرنا وتسمية الورقة التى تم النسخ فيها إلى زيوت بعد حذف كلمة إجماليات وهكذا مع جميع أوراق العمل التى تحتوى على كلمة إجماليات يتم نسخها فى نفس المصنف الجديد (إجماليات)

شكرا لكم

قام بنشر (معدل)

أخى لقد أرفقت لك ملف يحوى مثال بسيط

ما أريده فى المرفق هو

البحث فى أسماء الأوراق عن كلمة إجماليات عن طريق (For)

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

هما إجماليات زيوت و إجماليات قطع غيار

أريد إنشاء مصنف عمل جديد يتم نسخ الأعمدة الثلاثة الأولى بالإضافة إلى العمود الخامس

فى كل من الورقتين إلى هذا المصنف الجديد عن طريق إنشاء ورقتين فى المصنف الجديد تنسخ فيهما

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

أى يتم تسمية الورقتين بإسم زيوت و قطع غيار

شكرا لردك الكريم

ترحيل.rar

تم تعديل بواسطه Mohammed Farid
قام بنشر

أخى لقد أرفقت لك ملف يحوى مثال بسيط

ما أريده فى المرفق هو

البحث فى أسماء الأوراق عن كلمة إجماليات عن طريق (For)

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

هما إجماليات زيوت و إجماليات قطع غيار

أريد إنشاء مصنف عمل جديد يتم نسخ الأعمدة الثلاثة الأولى بالإضافة إلى العمود الخامس

فى كل من الورقتين إلى هذا المصنف الجديد عن طريق إنشاء ورقتين فى المصنف الجديد تنسخ فيهما

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

أى يتم تسمية الورقتين بإسم زيوت و قطع غيار

شكرا لردك الكريم

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

بعد اذن اخي الكربم ابو احمد

اخي الفاضل محمد

اعذرني

الفكرة المقترحة في حد ذاتها لا أرى انها عملية (هذه وجهة نظر شخصية)

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

والسؤال

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

اكرر اعتذاري عن وجهة نظري ان لم تعجبك

قام بنشر

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

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

قام بنشر

السلام عليكم

وبعد اذن الاستاذ احمد هذه محاولة على قد الحال


Public Sub Abu_Ahmed()

MySh = ActiveSheet.Name

If Mid(MySh, 1, 8) <> "إجماليات" Then Exit Sub

r = Mid(MySh, 9, Len(MySh) - 8)

    ActiveSheet.Copy Before:=Sheets(MySh)

    ActiveSheet.Name = r

    ActiveSheet.DrawingObjects.Delete

End Sub

شاهد المرفق

ترحيل (4).rar

  • Like 1
قام بنشر

السلام عليكم

وبعد اذن الاستاذ احمد هذه محاولة على قد الحال

[المرفق

اذا هاذا على قد الحال

ويش خليت لنا

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

رااااااااااااااااااااااااااااااااااائع جدا بارك الله فيك

قام بنشر

اذا هاذا على قد الحال

ويش خليت لنا

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

رااااااااااااااااااااااااااااااااااائع جدا بارك الله فيك

استاذ احمد زمان ابو ابراهيم

اشكر لك تواضعك وهذا اقل من بعض ما عندكم

قام بنشر

وبعد اذن اخي الحبيب عبدالله

هذه محاولة اخرى


Sub CPY_TOTALS()

	Sheets(Array("إجماليات قطع غيار", "إجماليات زيوت")).Copy

Workbooks(Workbooks.Count).Activate

For s = 1 To 2

Sheets(s).Select

Sheets(s).UsedRange.Select

	Selection.Copy

	Selection.PasteSpecial Paste:=xlPasteValues

Next s

End Sub

قام بنشر

شكرا لكم جزيلا إخوانى الكرام

من فضلكم أكملوا الجميل

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

قام بنشر

شكرا جزيلا على إبداعكم يا إخوانى

الأخ عبدالله أشكرك على أكوادك الرائعة ولكن طلبى الأخير لم يكن

عمل نسخة إحتياطية وإنما إنشاء ملف بالكود ونسخ أوراق العمل إليه

قام بنشر

وبعد اذن اخي الحبيب عبدالله

هذه محاولة اخرى


Sub CPY_TOTALS()

	Sheets(Array("إجماليات قطع غيار", "إجماليات زيوت")).Copy

Workbooks(Workbooks.Count).Activate

For s = 1 To 2

Sheets(s).Select

Sheets(s).UsedRange.Select

	Selection.Copy

	Selection.PasteSpecial Paste:=xlPasteValues

Next s

End Sub

لوجربت ده

رايح ينشأ ملف جديد به الورقتان

ويحول الدوال الى قيم فقط

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information