اخي محمد بن صالح
تفضل
Sub export_specificsheet()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Cells.Select
Application.CutCopyMode = False
Selection.Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
ActiveWorkbook.SaveAs Filename:="E:\العمل\" & "التقرير لتاريخ " & Format(Date - 1, "DD-MM-YYYY") & ".xlsm", _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWindow.Close
Range("a1").Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
الملف نسخ من ورقة لمصنف جديد بشروط.xlsm
اخي الملف يعمل بكفائة لدي
اخبرني بالنتيجة