将可变名称的工作表从一个工作簿复制到另一个工作簿

Question

我正在使用几年前发现的将一个工作表复制到新工作簿的代码，但它使用的cells.copy删除了一些重要的格式。我想使用sheets.copy来代替，但表名不断变化，我不知道如何编码。谢谢你的帮助。这是我目前使用的代码：

Sub SheetsToFiles() 
'Takes a sheet from a workbook and turns it into a file named after the 
sheet name 


Dim mySourceWB As Workbook 
Dim mySourceSheet As Worksheet 
Dim myDestWB As Workbook 
Dim myNewFileName As String 

' First capture current workbook and worksheet 
Set mySourceWB = ActiveWorkbook 
Set mySourceSheet = ActiveSheet 


' Build new file name based 
myNewFileName = mySourceWB.Path & "\" & mySourceSheet.Name & ".xlsx" 


' Add new workbook and save with name of sheet from other file 
Workbooks.Add 
ActiveWorkbook.SaveAs Filename:=myNewFileName 
Set myDestWB = ActiveWorkbook 

' Copy over sheet from previous file 
mySourceWB.Activate 
Cells.Copy 
myDestWB.Activate 
Range("A1").Select 
ActiveSheet.Paste 
Application.CutCopyMode = False 
ActiveWindow.DisplayGridlines = False 


' Resave new workbook 
ActiveWorkbook.Save 

' Close active workbook 
ActiveWorkbook.Close 


End Sub 

Answer 1

我会用Worksheet.copy方法将工作表复制到新的工作簿，这应该保存的格式原单。这里的代码更新与评论：

Sub SheetsToFiles() 
'Takes a sheet from a workbook and turns it into a file named after the Sheet Name 

Dim mySourceWB As Workbook 
Dim mySourceSheet As Worksheet 
Dim myDestWB As Workbook 
Dim myNewFileName As String 

' First capture current workbook and worksheet 
Set mySourceWB = ActiveWorkbook 
Set mySourceSheet = ActiveSheet 

' Build new file name based 
myNewFileName = mySourceWB.Path & "\" & mySourceSheet.Name & ".xlsx" 

' Create a new Workbook with one blank Worksheet (this will be deleted later) 
Set myDestWB = Workbooks.Add(xlWBATWorksheet) 

' Copy sheet to DestWB and paste after the first Worksheet 
mySourceSheet.Copy After:=myDestWB.Worksheets(1) 

' Delete the unused Worksheet, turn off alerts to bypass the confirmation box 
Application.DisplayAlerts = False 
myDestWB.Worksheets(1).Delete 
Application.DisplayAlerts = True 

' Save with name of sheet from other file 
myDestWB.SaveAs Filename:=myNewFileName 

' Close Destination workbook 
myDestWB.Close 

End Sub 

Answer 2

试试这个代码，

Sub SheetsToFiles() 
'Takes a sheet from a workbook and turns it into a file named after the 

    Dim mySourceWB As Workbook 
    Dim mySourceSheet As Worksheet 
    Dim myDestWB As Workbook 
    Dim myNewFileName As String 

    ' First capture current workbook and worksheet 
    Set mySourceWB = ActiveWorkbook 
    Set mySourceSheet = ActiveSheet 


    ' Build new file name based 
    myNewFileName = mySourceWB.Path & "\" & mySourceSheet.Name & ".xlsx" 

    ' Add new workbook and save with name of sheet from other file 
    Workbooks.Add 
    Set myDestWB = ActiveWorkbook 
    myDestWB.SaveAs Filename:=myNewFileName 

    ' Copy over sheet from previous file 
    mySourceSheet.Range("A1:Z100").Copy Destination:=myDestWB.Sheets("Sheet1").Range("A1:Z100") 

    ActiveWindow.DisplayGridlines = False 
    ' Resave new workbook 
    ActiveWorkbook.Save 
    ' Close active workbook 
    ActiveWorkbook.Close 
End Sub