اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

نسخ أوراق العمل بشروط


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

السلام عليكم

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

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

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

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

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

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

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

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

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

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

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

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

شكرا لكم

رابط هذا التعليق
شارك

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

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

البحث فى أسماء الأوراق عن كلمة إجماليات عن طريق (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

لوجربت ده

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

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

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information