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

انشاء ملف جديد بالكود


mselmy

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

أخي الحبيب

يرجى تغيير اسم الظهور للغة العربية

إليك الكود التالي عله يفي بالغرض

Sub ExportSpecificSheets()
    Dim ArrSheetToCopy, I As Long

    If MsgBox("هل تريد نسخ أوراق العمل المحددة إلى مصنف جديد؟", vbYesNo, "NewCopy") = vbNo Then Exit Sub

    ArrSheetToCopy = Array("التحويل", "المستبعدين")

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        With Workbooks.Add
            For I = (.Sheets.Count + 1) To (UBound(ArrSheetToCopy) + 1)
                .Sheets.Add
            Next I
    
            For I = 0 To UBound(ArrSheetToCopy)
                ThisWorkbook.Sheets(ArrSheetToCopy(I)).Cells.Copy
                With .Sheets(I + 1)
                    .Cells.PasteSpecial xlPasteAll
                    .Cells.Copy
                    .Cells.PasteSpecial xlPasteValues
                    .Name = ThisWorkbook.Sheets(ArrSheetToCopy(I)).Name
                    .DisplayRightToLeft = False
                    .Select: .Range("A1").Select
                End With
            Next I
    
            .SaveAs ThisWorkbook.Path & "\" & Sheet2.Name & ".xlsm", xlOpenXMLWorkbookMacroEnabled
            .Close
        End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

إليك الملف المرفق عله يكون المطلوب

تقبل تحياتي

 

Test This File.rar

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

الحمد لله أن تم المطلوب على خير

يرجى تغيير اسم الظهور للغة العربية

لمزيد من التفاصيل يمكنك الإطلاع على رابط التوجيهات في الموضوعات المثبتة في المنتدى

نتمنى لكم جميعاً ليلة طيبة مباركة وتصبحون على خير

دمتم على طاعة الله

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

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

 مثال تغيير اسم الورقه من  التحويل الى تحويل شهر يناير

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

بارك الله فيك أخي الحبيب ياسر العربي على الكود الجميل

لكن كما ذكر الأخ السائل .. أنه في هذه الحالة سيكون هناك ارتباط بين المصنفين

كما أن الكود طويل لأنه يحتوي على إلغاء خاصية اهتزاز الشاشة وإعادة تفعيلها ، وإلغاء خاصية التنبيه بالرسائل وإعادة تفعيلها .. وذلك لتجنب حدوث خطأ في حالة تنفيذ الكود مرة أخرى

كما أنه يحتوي أسطر لنسخ أوراق العمل بالتنسيقات ثم نسخها مرة أخرى بالقيم فقط ..مما يحافظ على التنسيق الأصلي للملف وفي نفس الوقت يتم لصق القيم فقط لإلغاء الارتباط

 

أخ السائل

يمكنك تغيير اسم الظهور من خلال الإطلاع على رابط التوجيهات في الموضوعات المثبتة في المنتدى

من هنا لمعرفة التفاصيل

 

بالنسبة لسؤالك غير السطر الثالث ليكون بهذا الشكل

ArrSheetToCopy = Array(Sheet2.Name, Sheet3.Name)

 

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

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