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

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


AL_AYMAN

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

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

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

أولا

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

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

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

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

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

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

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

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

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

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

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

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

post-19313-0-88358100-1340023313_thumb.p

Test1.rar

Test2.rar

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

  • 6 months later...

السلام عليكم

أخي العزيز

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

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

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

الأولي

ملف 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

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

  • 4 years later...

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

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

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

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

تم تعديل بواسطه محمود نعيم
رابط هذا التعليق
شارك

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

أخي الكريم

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

بفرض أن كلمة السر لحماية الورقة هي "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

 

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

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

 

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

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