احمد حبيبه قام بنشر أبريل 6, 2016 قام بنشر أبريل 6, 2016 في ٢١/٠٣/٢٠١٦ at 04:41, ياسر خليل أبو البراء said: أخي الكريم أحمد حبيبة جرب الكود التالي ..يمكنك تغيير اسم ورقة العمل في السطر المشار إليه في التعليق Sub SplitSpecificSheet() Dim xPath As String Dim SH As Worksheet xPath = Application.ActiveWorkbook.Path Set SH = Sheets("Data") 'غير اسم ورقة العمل المراد تصديرها Application.ScreenUpdating = False Application.DisplayAlerts = False With SH .Copy Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & .Name & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled Application.ActiveWorkbook.Close False End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub تقبل تحياتي اخى واستاذى الفاضل ....اعذرنى لم ارى ردك الا اليوم ...لى عند حضرتك ثلاث طلبات الاول ... هل يمكن استخراج الصغحة المطلوبه فى ملف اسمه تصدير الثانى هل يمكن تغيير امتداد الملف المستخرج الى صيغة xls الثالث .. هل يمكن ان تكون محتويات الملف المصدر قيم فقط بدون دوال او ارتباطات اشكرك جدا جدا وادعوا لك دائما بظهر الغيب...تقبل تحياتى
ياسر خليل أبو البراء قام بنشر أبريل 6, 2016 الكاتب قام بنشر أبريل 6, 2016 أخي الكريم أفضل طرح موضوع جديد ترفق فيه ملفك .. وإن شاء الله إذا تيسر لي الوقت سأحاول بالتأكيد العمل عليه تقبل تحياتي
احمد حبيبه قام بنشر أبريل 14, 2016 قام بنشر أبريل 14, 2016 استاذى الفاضل فى الملف المرفق اريد من حضرتك التالى صفحة data بها دوال ... ارجوا ضبط الكود ليقوم بنسخ القيم فقط دون الدوال في الملف الذى سيخرخ خارج الملف ...كما ارجو استخراج صفحة data داخل الملف المرفق المسمى تصديرات الاستخراج.rar
ياسر خليل أبو البراء قام بنشر أبريل 14, 2016 الكاتب قام بنشر أبريل 14, 2016 أخي الحبيب أحمد هل طرح موضوع جديد بالأمر الصعب ..حيث أن الطلبات في المشاركات الفرعية لا يهتم بها الأعضاء ففضلاً اطرح موضوع مستقل بطلبك لتجد تفاعل من إخوانك بالمنتدى
مهند الزيدي قام بنشر مايو 2, 2016 قام بنشر مايو 2, 2016 وفقك الله لك خير أخي ياسر ... وجعله في ميزان حسناتك.. أخي ياسر إذا أردنا أن يكون انشطار الصفحات بدون معادلات اي أن تكون الصفحة تحتوي على القيم فقط ولاتحنوي على المعادلات المرتبطة بالصفحات الإخرى داخل المصنف الأصلي إستخدمت الكود التالي اكن لم ينفع أرجو الحل وفتح موضوع على مدونتك الرائعة ..الكود SH.UsedRange.Value = SH.UsedRange.Value وفقك الله للصالحات ... وجميع من في المنتدى
ياسر خليل أبو البراء قام بنشر مايو 2, 2016 الكاتب قام بنشر مايو 2, 2016 أخي الكريم مهند من المفترض أن السطر الذي أرفقته يقوم بعمل المطلوب تماماً ويحول المعادلات لقيم وهذا هو الغرض من هذا السطر لذا يرجى إرفاق ملفك الذي يحتوي الكود مع إرفاق صورة للخطأ و في أي سطر هذا الخطأ .. جرب السطر التالي لعله يفي بالغرض sh.Cells.Copy sh.Cells.PasteSpecial xlPasteValues Application.CutCopyMode = False تقبل تحياتي
مهند الزيدي قام بنشر مايو 2, 2016 قام بنشر مايو 2, 2016 أخي العزيز ياسر .. شكرا لإستجابتك على طلبي .. لك أمتناني وإحترامي الكثير.. أخي الغالي ... تمت التجربة على ملفك الرائع في الموضوع..لقد عملت معادلة في أحد الصفحات في الملف الأصلي ..وعندما وضعت التعديل الذي عملته ..تم إخراج الصفحة وكانت الخلية مرتبطة بالملف الاصلي ..وتمت العملية في الملف الأصلي ..أي أن المعادلة في الملف الإصلي تحولت إلى قيمة .. علما أني قمت بتعديل الكود حسب ماوجهتني هكذا For Each SH In ThisWorkbook.Sheets SH.Copy SH.Cells.Copy SH.Cells.PasteSpecial xlPasteValues Application.CutCopyMode = False Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & SH.Name & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled Application.ActiveWorkbook.Close False Next وأرجوا أن أكون قد وفقت في شرح المشكلة .. وجزاك الله خيرا ...,آسف على كثرة الأسئلة .. ونصيحة لكل من في المنتدى زيارة مدونة الاخ ياسر لان بها مواضيع شيقة ومفيدة ..واتمنى ان يحفظ الله الاخ ياسر لما له من فضل في هذا المنتدى الكبير .
ياسر خليل أبو البراء قام بنشر مايو 2, 2016 الكاتب قام بنشر مايو 2, 2016 الكود مش مضبوط تماماً ممكن رابط الموضوع عشان أقدر أحدد المشكلة فين بالضبط أخي الكريم مهند أعطني رابط الموضوع وضع السطر فقط الذي تظهر فيه المشكلة ... لأضع يدي على المشكلة بالضبط والأفضل كما أخبرتك إرفاق ملف ... لأن الكود بالتأكيد يعمل في الملف المرفق في الموضوع الأصلي ..
مهند الزيدي قام بنشر مايو 2, 2016 قام بنشر مايو 2, 2016 شكرا لك أخي العزيز " ياسر " لا أعرف كيف اجازيك .. ولكن ليس لي سوى الدعاء لك ولوالديك.. أني اتكلم في نفس الموضوع ونفس الملف المرفق عن طريق حضرتك ..سوف أرفق الملف تجنبا لاي اشكال مستقبلا... أعمل أي معادلة في الصفحات في اي مكان .. ونفذ الكود بعد التعديل .وشاهد النتيجة .. أتمنى أن تجد الحل .لانه ملف راقي وفكرة ممتازة .. وفقك الله لكل خير Split Workbook Into Multiple Workbooks1.rar 1
ياسر خليل أبو البراء قام بنشر مايو 2, 2016 الكاتب قام بنشر مايو 2, 2016 جرب السطر التالي بعد سطر Sh.Copy ActiveWorkbook.ActiveSheet.UsedRange.Value = ActiveWorkbook.ActiveSheet.UsedRange.Value وأنتظر الرد منك سريعاً لأنني سأنشغل في أمور خاصة بعد قليل أنا عندي ملفات لا حصر لها ولا أستطيع تذكر الملف الذي تتحدث عنه ولا الموضوع ..الزهايمر بيعمل عمايله معايا .. لذا فارفق ملف دائماً أو ضع رابط الموضوع أو الكود الذي تتحدث عنه كما فعلت في مشاركتك السابقة تقبل تحياتي
مهند الزيدي قام بنشر مايو 3, 2016 قام بنشر مايو 3, 2016 شكرا لك اخي ياسر وفقك الله لكل خير ..تم المطلوب والحمد لله رب العالمين وآسف على عدم الرد السريع لظروف خاصة .. رزقك الله الصحة والعافية 1
ياسر خليل أبو البراء قام بنشر مايو 3, 2016 الكاتب قام بنشر مايو 3, 2016 أخي العزيز مهند الحمد لله أن تم المطلوب على خير .. وأعتذر لإلحاحي في طلب الكود أو لرابط الموضوع ..لأنني بالفعل لا أحفظ أكواد على الإطلاق ..إنما يمن الله علي بكتابة كود واقتباس من كود آخر إلى أن يمن الله علي بالانتهاء من الكود المطلوب بالشكل المطلوب وأطرح الحل أو الموضوع وربما أنسى الكثير مما كتبته ... فقد كتبت الكثير لدرجة أنني أنسى أنني كتبت هذا الكود أو ذاك ... والله وحده يعلم بحالي الحمد لله الذي بنعمته تتم الصالحات ... وفقني الله وإياك لكل خير تقبل تحياتي 1
مهند الزيدي قام بنشر مايو 3, 2016 قام بنشر مايو 3, 2016 أخي العزيز " ياسر " .. اتمنى أن لا اكون أثقلت عليك بطلباتي الكثيرة .. عند تكون أحدى أوراق العمل تجتوي على كود اي كان في داخل حدث الورقة ..وعند تنفيذ الكود الرائع لإنشطار اوراق العمل في المصنف .. تظهر رسالة خطأ وتوقف عملية الإنشطار .. هل من الممكن إضافة بسيطة بحيث عن تقسيم الاوراق يتم حذف الكود في حدث الورقة .. مع شكري وإمتناني الكثير لك اخي العزيز .. علما اني وجدت في مدونتك الرائعة نفس الفكرة واتمنى أن يتم تطبيقها على هذا الموضوع ,هذا رابط الموضوع في المدونة https://yasserkhalilexcellover.blogspot.com/2016/04/export-specific-sheet-to-new-workbook.html
ياسر خليل أبو البراء قام بنشر مايو 3, 2016 الكاتب قام بنشر مايو 3, 2016 أخي الكريم مهند بالفعل هي نفس الفكرة تماماً لما لا تقوم باستخدامها في الكود لديك قم بإضافة السطر التالي قبل تنفيذ الكود Application.EnableEvents = False وفي نهاية الكود تستخدم نفس السطر مع تحويل القيمة إلى True ولحذف الكود من ورقة العمل التي ستقوم بتصديرها وستستخدم هذه الأسطر للإشارة إلى ورقة العمل المراد حذف الكود منها strName = Worksheets("Data").CodeName With ActiveWorkbook.VBProject.VBComponents(strName).CodeModule .DeleteLines 1, .CountOfLines End With ولا تنسى أيضاً السطر الذي سيقوم بالحفظ Application.ActiveWorkbook.Close True 1
مهند الزيدي قام بنشر مايو 3, 2016 قام بنشر مايو 3, 2016 أخي العزيز ياسر . لقد حاولت تطبيق نفس الكود ..ولكن أريد أن يتم حذف الأكواد في أي صفحة وليس فقط الصفحة ( Data) وقد عدلت الكود بهذه الطريقة ولم تنجح ..أرجو التعديل الصحيح .. وفقك الله لكل خير strName =SH.CodeName With ActiveWorkbook.VBProject.VBComponents(strName).CodeModule .DeleteLines 1, .CountOfLines End With
ياسر خليل أبو البراء قام بنشر مايو 3, 2016 الكاتب قام بنشر مايو 3, 2016 أخي الكريم مهند يرجى دائماً عند حدوث مشكلة أن نرفق صورة للمشكلة والسطر الأصفر الذي تظهر معه المشكلة لتحديد الثغرة أو المشكلة بدقة من المفترض أن السطر الذي قمت بالتعديل عليه صحيح .. ولكن سؤال هل قمت بالإعلان عن المتغير strName حيث أنه متغير نصي .. قد تكون المشكلة في تلك النقطة تم شرح الموضوع من جديد بالطلبات الجديدة على الرابط التالي الرابط من هنا تقبل تحياتي 1
مهند الزيدي قام بنشر مايو 3, 2016 قام بنشر مايو 3, 2016 شكرا لك أخي العزيز .. ياسر .. لقد قمت بالإعلان على المتغير strName كما في الكود .. الصور المرفقة تبين الخطأ ...
مهند الزيدي قام بنشر مايو 3, 2016 قام بنشر مايو 3, 2016 أخي العزيز ياسر ... وفقك الله لكل خير ... بعد تغير إعدادات الماكرو كما يلي ..تم حل المشكلة ...الحمد لله رب العالمين ..لقد أتعبتك معي جزاك الله خيرا ..بما تقدمه من مشورة ونصح 1
ياسر خليل أبو البراء قام بنشر مايو 3, 2016 الكاتب قام بنشر مايو 3, 2016 الحمد لله الذي بنعمته تتم الصالحات أكدت مراراً وتكراراً على أن الموضوع في الرابط التالي هو رقم 1 في تعلم الأساسيات وبه بدأت المدونة وكثيراً ما أشير إليه فهو الأساس وفيه تطبيق لما قمت به أي أنه يجب تطبيق الموضوع بشكل جيد .. والتعرف على بيئة محرر الأكواد والأساسيات بشكل عام الرابط من هنا المهم أنه تم حل المشكلة .. وبفضل الله ثم بفضلك تم طرح موضوع جديد بهذا الخصوص ..ليستفيد الجميع 1
حسام مصطفي قام بنشر أبريل 10, 2017 قام بنشر أبريل 10, 2017 (معدل) في ٢٠/٣/٢٠١٦ at 19:41, ياسر خليل أبو البراء said: أخي الكريم أحمد حبيبة جرب الكود التالي ..يمكنك تغيير اسم ورقة العمل في السطر المشار إليه في التعليق Sub SplitSpecificSheet() Dim xPath As String Dim SH As Worksheet xPath = Application.ActiveWorkbook.Path Set SH = Sheets("Data") 'غير اسم ورقة العمل المراد تصديرها Application.ScreenUpdating = False Application.DisplayAlerts = False With SH .Copy Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & .Name & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled Application.ActiveWorkbook.Close False End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub تقبل تحياتي استاذي القدير / ياسر هل يمكن اختيار اكثر من ورقة ( يتم تحديدهم بمعرفتي ) لنسخها في ملف آخر وتسميته بتاريخ اليوم مثلا حيث حاولت ان اضع مكان SH هنا السطر Set SH = Sheets(Array("Data", "Sheet2", "Sheet3")) ولكن الامر لم يفلح معي .. فما هي المشكلة او الكود الصحيح لتنفيذ ذلك وهل يمكن النسخ كقيم بدون معادلات تم تعديل أبريل 10, 2017 بواسطه حسام مصطفي
محمد طاهر عرفه قام بنشر أبريل 11, 2017 قام بنشر أبريل 11, 2017 السلام عليكم اذا اردت تكرار الامر علي عدد من اوراق العمل التي تختارها بمعرفتك عن طريق تحديد اسمها ، يمكنك تكرار الجزء الاوسط من الكود كما يلي: Sub SplitSpecificSheet() Dim xPath As String Dim SH As Worksheet xPath = Application.ActiveWorkbook.Path Application.ScreenUpdating = False Application.DisplayAlerts = False ' Sheet1 Set SH = Sheets("Sheet1") With SH .Copy Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & .Name & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled Application.ActiveWorkbook.Close False End With ' Sheet2 Set SH = Sheets("Sheet2") Application.ScreenUpdating = False Application.DisplayAlerts = False With SH .Copy Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & .Name & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled Application.ActiveWorkbook.Close False End With Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub 2
حسام مصطفي قام بنشر أبريل 11, 2017 قام بنشر أبريل 11, 2017 كل الشكر الجزيل لسيادتكم استاذنا الفاضل وهل يمكن ان يتم نقل الشيتات المختارة كما في الكود لملف واحد معا ( وليس كل شيت لملف منفصل ) وياريت لو بدون معادلات ( قيم فقط ) جزاك الله خيرا استاذنا الكبير
محمد طاهر عرفه قام بنشر أبريل 11, 2017 قام بنشر أبريل 11, 2017 السلام عليكم لنقل ورقتي عمل او اكثر لنفس الملف ، هنا اعليك اختيار اسم الملف و قد اخترته officena على سبيل المثال Sub SplitSpecificSheet_onefile() Dim xPath As String xPath = Application.ActiveWorkbook.Path Application.ScreenUpdating = False Application.DisplayAlerts = False Sheets(Array("Sheet1", "Sheet2")).Select Sheets(Array("Sheet1", "Sheet2")).Copy Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & "officena" & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled Application.ActiveWorkbook.Close False Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub و لتحويل المعادلات لارفام نضيف جزء جديد Sub SplitSpecificSheet_onefile() Dim xPath As String xPath = Application.ActiveWorkbook.Path Application.ScreenUpdating = False Application.DisplayAlerts = False Sheets(Array("Sheet1", "Sheet2")).Select Sheets(Array("Sheet1", "Sheet2")).Copy For k = 1 To ActiveWorkbook.Sheets.Count ActiveWorkbook.Sheets(k).Activate Cells.Select Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Next k Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & "officena" & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled Application.ActiveWorkbook.Close False Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub
حسام مصطفي قام بنشر أبريل 11, 2017 قام بنشر أبريل 11, 2017 استاذي القدير لا اعلم كيف اشكرك علي سرعة ردك وعلي الرد الاكثر من رااائع وهل يمكن لي ان اطمع في كرم سيادتكم بطلب آخر بانه اذا كان في الشيتات التي يتم نسخها لشيت جديد معادلات يتم نسخها كقيم فقط في الشيت الجديد وشكر جزيل الشكر جزاك الله خيرا استاذنا القدير
محمد طاهر عرفه قام بنشر أبريل 11, 2017 قام بنشر أبريل 11, 2017 و لتحويل المعادلات لارفام نضيف جزء جديد Sub SplitSpecificSheet_onefile() Dim xPath As String xPath = Application.ActiveWorkbook.Path Application.ScreenUpdating = False Application.DisplayAlerts = False Sheets(Array("Sheet1", "Sheet2")).Select Sheets(Array("Sheet1", "Sheet2")).Copy For k = 1 To ActiveWorkbook.Sheets.Count ActiveWorkbook.Sheets(k).Activate Cells.Select Application.CutCopyMode = False Selection.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Next k Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & "officena" & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled Application.ActiveWorkbook.Close False Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub 2 1
الردود الموصى بها