تفضل هذ الكود يقوم بعمل حفظ لكل ورقة منفصلة بملف منفصل
Option Explicit
Sub SplitWorkbook()
'ÊÚÑíÝ ÇáãÊÛíÑ ãä ÇáäæÚ ÇáäÕí
Dim xPath As String
'ÊÚÑíÝ ÇáãÊÛíÑ ãä ÇáäæÚ æÑÞÉ Úãá
Dim SH As Worksheet
'ÊÚííä ÇáãÊÛíÑ áÊÓÇæí ÞíãÊå ãÓÇÑ ÇáãÕäÝ ÇáÍÇáí
xPath = Application.ActiveWorkbook.Path
'ÅáÛÇÁ ÎÇÕíÉ ÇåÊÒÇÒ ÇáÔÇÔÉ
Application.ScreenUpdating = False
'ÅáÛÇÁ ÎÇÕíÉ ÑÓÇÆá ÇáÊäÈíå
Application.DisplayAlerts = False
'ÍáÞÉ ÊßÑÇÑíÉ áßá ÃæÑÇÞ ÇáÚãá ÈÇáãÕäÝ
For Each SH In ThisWorkbook.Sheets
'äÓÎ æÑÞÉ ÇáÚãá
SH.Copy
'ÍÝÙ æÑÞÉ ÇáÚãá ÈäÝÓ ÇáÇÓã æäÝÓ ÇáãÓÇÑ
Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & SH.Name & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
'ÅÛáÇÞ ÇáãÕäÝ ÇáÌÏíÏ æÇáÐí ÃÕÈÍ åæ ÇáãÕäÝ ÇáäÔØ
Application.ActiveWorkbook.Close False
'ÇáÇäÊÞÇá áæÑÞÉ ÇáÚãá ÇáÊÇáíÉ
Next
'ÊÝÚíá ÎÇÕíÉ ÑÓÇÆá ÇáÊäÈíå
Application.DisplayAlerts = True
'ÊÝÚíá ÎÇÕíÉ ÇåÊÒÇÒ ÇáÔÇÔÉ
Application.ScreenUpdating = True
End Sub