Добрый день  
 
Макросом:  
Sub test()  
   Dim wbNew As Workbook  
   Dim sh As Worksheet  
     
   For Each sh In ThisWorkbook.Sheets  
   Set wbNew = Workbooks.Add  
       sh.Copy Before:=wbNew.Sheets(1)  
       Application.DisplayAlerts = False  
           While wbNew.Sheets.Count <> 1  
               wbNew.Sheets(wbNew.Sheets.Count).Delete  
           Wend  
       Application.DisplayAlerts = True  
       wbNew.SaveAs (ThisWorkbook.Path & "\" & sh.Name)  
       wbNew.Close False  
   Next sh  
End Sub