☰

如何将每个工作表复制到新工作簿并保留格式

tag-icon • tag-icon microsoft-excel microsoft-excel-2007 vba
如何将每个工作表复制到新工作簿并保留格式

正如我的标题所示，我有以下代码：

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

但问题是工作表在复制时没有保留源格式。有没有办法保留此代码并添加一些小额外内容来获得我想要的东西？谢谢

答案1

我不确定哪些格式没有保留，但我手动将一张表复制到新的工作簿中，并且格式被正确复制（您的代码应该可以工作）

或者您可以尝试以下操作，将每张工作表保存为单独的 .xlsm：

Option Explicit

Public Sub saveWS()
    Dim ws As Worksheet

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

答案2

为什么不直接用新名称保存工作簿，而是创建一个新的工作簿，然后将每张工作表复制到其中？

相关内容