طلب تعديل كود vba لنسخ شيتات معينة لملف آخر مستقل

[محمد هشام.]

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

إخواني الأعزاء هذا الكود قد تم تزويدي به في موضوع سابق  من طرف أخونا عبد الفتاح يقوم بنسخ شيتات معينة لمصنف آخر مستقل هو شغال تمام لاكن كنت عاوز من أحد الأستاذة الأفاضل تعديل الكود لكي أستطيع تسمية الشيتات المنسوخة بإسم آخر غير الموجود في الملف الرئيسي يعني لو تم نسخ shets 1 و shets 5 كمثال يتم تسميتهم تلقائيا بعد  الاستخراج ب مبيعات ١ ومبيعات ٢ 

Sub export_sheets()
   Dim Fname As String, ws As Worksheet

    Application.DisplayAlerts = False
    
        Sheets(Array("SH1", "SH3")).Copy
        For Each ws In ActiveWorkbook.Sheets
            ws.UsedRange = ws.UsedRange.Value
        Next ws
        
        ActiveWorkbook.SaveAs Filename:= _
"C:\Users\PC WORLD\Desktop\" & " report_ " & "W" & Format(Date, "WW") & "_" & Format(Date, "YYYY") & ".xlsx", FileFormat:=51
        ActiveWorkbook.Close
    Application.DisplayAlerts = True
End Sub

تم تعديل مارس 2, 2022 بواسطه Hicham1470

[عبدالفتاح في بي اكسيل]

لماذا  لا تضع  اسماء  في  عمود  محدد لشيت  معينة  

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

[عبدالفتاح في بي اكسيل]

ماكرو لتسمية الاوراق

Option Explicit
Sub renamesheets()
Dim sheetsold()
Dim sheetsnew()
Dim lngSht As Long
Dim  ws As Worksheet
'الاسماء الجديدة
   sheetsnew = Array("selling1", "selling2")
'الاسماء القديمة 
    sheetsold = Array("SH1", "SH3")
     On Error Resume Next
    For lngSht = LBound(sheetsold) To UBound(sheetsold)
        Set ws = Nothing
        Set ws = Sheets(sheetsold(lngSht))
        If Not ws Is Nothing Then ws.Name = sheetsnew(lngSht)
    Next lngSht
End sub

 

[محمد هشام.]

 كود ولا أروع👍  ما شاء الله عليك أخي عبد الفتاح بحثت على زر يعبر عن شيئ أكثر بكثير عن أفضل إجابة ولم أجده فعلا شكرا لك بجد . 🤝🤝🤝