Как я могу скопировать каждый лист в новую книгу и сохранить форматирование

Question

Как в моем названии .. У меня есть следующий код:

Sub SaveSheets(yeard, monthd)
Dim strPath As String
Dim ws As Worksheet

Application.ScreenUpdating = False

strPath = ActiveWorkbook.Path & "\" & yeard & "\"
If Len(Dir(strPath, vbDirectory)) = 0 Then
    MkDir (strPath)
End If
strPath = ActiveWorkbook.Path & "\" & yeard & "\" & monthd & "\"
If Len(Dir(strPath, vbDirectory)) = 0 Then
    MkDir (strPath)
End If

For Each ws In ThisWorkbook.Sheets
    ws.Copy
    BreakLinks Workbooks(Workbooks.Count)
    Workbooks(Workbooks.Count).Close True, strPath & ws.Name & " DATASET " & monthd & " " & yeard & ".xlsx"
Next
Application.ScreenUpdating = True
End Sub
Sub BreakLinks(wb As Workbook)
    Dim lnk As Variant
    For Each lnk In wb.LinkSources(xlExcelLinks)
        wb.BreakLink lnk, xlLinkTypeExcelLinks
    Next
End Sub

Но проблема в том, что рабочий лист копируется без сохранения исходного форматирования. Есть ли способ сохранить этот код и добавить что-то небольшое, чтобы получить то, что я хочу? Спасибо

Answer 1

Я не уверен, какое форматирование не сохранилось, но я вручную скопировал один лист в новую книгу, и форматирование было скопировано правильно (ваш код должен работать)

Или вы можете попробовать следующее, что сохраняет каждый лист как отдельный файл .xlsm:

Option Explicit

Public Sub saveWS()
    Dim ws As Worksheet

    For Each ws In Worksheets
        ws.SaveAs ws.Name, xlOpenXMLWorkbookMacroEnabled
    Next
End Sub

Answer 2

Вместо того, чтобы создавать новую рабочую книгу и затем копировать в нее каждый лист, почему бы просто не сохранить рабочую книгу с новым именем?