ارجو المساعدة فى كودين فى غاية الاهمية بالنسبة لى لجلب البيانات وتحديث البيانات

[AL_AYMAN]

السادة فريق المنتدى

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

أولا

اود ان اشكركم على سرعة استجابتكم فى الرد على المشكلات التى تواجهنا فى العمل على الاكسل

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

واعترف باننى تعلمت الكثير من هذا المنتدى الرائع ومن السادة فريق المنتدى والسادة الاعضاء الذين لا يبخلون علينا باى معلومة

واليكم ما اريدة

1 - بالمرفقات ملفات اول ملف وهو Test 1 بة 5 ورقات عمل تم تسميتهم من 1 الى 5 وبكل ورقة PivotTable وهذه الاوراق مخفية

اريد كود يعمل تحديث لهذه الجداول PivotTable بمجرد تفعيل الكود من خلال زر وكيفة اضافة اوراق اخرى فى الكود ى

2- بالمرفقات الملفين Test1 و Test2 بهم 3 ورقات عمل لهم نفس الاسم وهم Dat1-Data2-Data3

المطلوب كود يقوم بجلب البيانات الموجودة بالملف Test2 والتى بالورقة Data1 الى الملف Test 1 ووضعها فى الورقة Data1

ويتم عمل الكود من خلال الضغط على زر وايضا كيفية اضافة اوراق عمل اخرى الى الكود

3- بالمرفقات رسالة تظهر لى عند حفظ ملف بة ماكرو ولا ادرى ما حل هذه المشكلة

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

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

Test1.rar

Test2.rar

[AL_AYMAN]

السادة فريق الموقع

حتى الان لم يتم الرد على مشكلتى التى عرضتها عليكم

برجاء مساعدتى فى حلها للاهمية

وشكرا لحسن تعاونكم معنا

[AL_AYMAN]

افهم من كدة ان مفيش حل لمشكلتى ؟؟؟

[AL_AYMAN]

انا منتظر الرد لن ايأس

لاننى كلى ثقة فى فريق النوقع واعرف مدى ضيق الوقت

ولكن لا تجعلونى انتظر طويلا

وشكرا

[AL_AYMAN]

ما زلت منتظر ردكم ومساعدتكم لى

وشكرا

[طارق محمود]

السلام عليكم

أخي العزيز

أعتذر لك مرة بالنيابة عن كل الأعضاء الذين حاولوا ولم يردوا حتي بكلمة

ومرة أخري لطول الوقت ، ولكني لم أر الموضوع إلا اليوم

وأرجو أن تكون قد حللت مشاكلك وإلا فلنتابعها واحدة بواحدة

الأولي

ملف Test1 بة 5 ورقات عمل تم تسميتهم من 1 الى 5 وبكل ورقة PivotTable وهذه الاوراق مخفية

تريد كود يعمل تحديث لهذه الجداول PivotTable بمجرد تفعيل الكود من خلال الزر

مرفق الملف وبه الكود المطلوب

وهذل هو الكود

Sub Macro1()


For i = 1 To 5

For j = 1 To Sheets.Count

If Sheets(j).Name = Format(i, "#") Then

With Sheets(j)

.PivotTables("PivotTable1").PivotCache.Refresh

.Visible = Hidden

End With

End If

Next j

Next i

End Sub

أما عن كيفة اضافة اوراق اخرى فى الكود

فقط عليك الإستمرار في التسمية بعد 5 يعني 6،7، ... إلي مايكفيك مثلا 20

ثم تغير السطر الأول من الكود إلي

For i = 1 To 20

تفضل الملف وبه الكود

وسأتابع معك باقي النقاط

Test1.rar

[طارق محمود]

سأترك المشكلة الثانية مؤقتا وأجيب علي الثالثة قبلها

رسالة تظهر لى عند حفظ ملف بة ماكرو ولا ادرى ما حل هذه المشكلة

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

وهي رسالة بدأت في الظهور من إكسل 2007 ومابعدها

أي أنك ببساطة إن لم يكن عندك ماكرو (كود) أو عندك كود ولاتريد الإحتفاظ به ، فتحفظ الملف عادي بالإمتداد xlsx

أما إن كنت تريد الماكرو (كود) فتحفظ الملف بالإمتداد xlsm

وبطريقة أخري إن حفظت الملف الذي به ماكرو بالإمتداد xlsx وأهملت الرسالة

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

[طارق محمود]

السلام عليكم

والآن مع آخر النقطة عندك

الثانية

الملفين Test1 و Test2 بهم 3 ورقات عمل لهم نفس الاسم وهم Dat1-Data2-Data3

المطلوب كود يقوم بجلب البيانات الموجودة بالملف Test2 والتى بالورقة Data1 الى الملف Test 1 ووضعها فى الورقة Data1

ويتم عمل الكود من خلال الضغط على زر

بالمرفق الزر الأصفر يقوم بعمل ذلك بالشروط التالية

أن يكون الملفين في نفس المجلد

أن يكون أسماء الشيتات المراد نقلها متطابقة وكلها تبدأ بـكلمة Data

أن الترحيل سيكون في آخر الشيت الذي يحمل نفس الإسم من الملف الأول يعني لو أن Data1 كلن به 2000 سطر ثم Data1 من المملف الثاني به 40 سطر بيانات (بغض النظر عن سطر العناوين الأول) ، فسيكون النتيجة النهائية 2040 سطر

لايشمل الكود فرز إذا كانت البيانات مكررة (يعني لو ضغطت علي الزر مرتين فسيتكرر بيانات ورقات الملف الثاني في آواخر ورقات الملف الأول)

الكود هو

Sub Macro2()

On Error Resume Next

Nm = ActiveWorkbook.Name

pt = ActiveWorkbook.Path


Workbooks.Open Filename:=pt & "\Test2.xlsx"

Nm2 = ActiveWorkbook.Name

For i = 1 To 3

Workbooks(Nm2).Activate

sht = "Data" & i

Sheets(sht).Select

Range("A2:X" & [A9999].End(xlUp).Row).Copy

Workbooks(Nm).Activate

Sheets(sht).Visible = True

Sheets(sht).Select

[A9999].End(xlUp).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues

Sheets(sht).Visible = Hidden

Next i

End Sub

الجزء الأخير من السؤال

وايضا كيفية اضافة اوراق عمل اخرى الى الكود

نفس الإجابة بالسؤال الأول

فقط عليك الإستمرار في التسمية بعد Data3 مثلا : Data4 , Data5 , Data6 , Data7 , Data8 , Data9 , ، ... إلي مايكفيك مثلا 20

ثم تغير السطر بالكود

من

For i = 1 To 3

إلي

For i = 1 To

20

تفضل الملف وبه الكود الأول والكود الثاني

Test1.rar

[محمود نعيم]

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

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

وشكرا ;;;;;;;;;;;;;;

متابعة العملاء.rar

تم تعديل سبتمبر 11, 2017 بواسطه محمود نعيم

[طارق محمود]

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

أخي الكريم

ضع الكود التالي في حدث الورقة

بفرض أن كلمة السر لحماية الورقة هي "xyxy"

Private Sub Worksheet_Activate()
    ActiveSheet.Unprotect ("xyxy")
    ActiveSheet.PivotTables("PivotTable7").PivotCache.Refresh
    ActiveSheet.Protect("xyxy", DrawingObjects:=False, Contents:=True, Scenarios:=False) = True
End Sub

 

[طارق محمود]

إليك الملف وبه الكود
يتم تنشيط الكود أوتوماتيكيا إذا ذهبت للورقة التي بها تقرير PivotTable

متابعة العملاء1.rar

[محمود نعيم]

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