將可變名稱的工作表從一個工作簿複製到另一個工作簿

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