Question

我目前正在使用几年前发现的代码将一个工作表复制到一个新的工作簿，但它使用了cell.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

试试这段代码，

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

Answer 2

我会使用Worksheet.copy方法将Worksheet复制到新的工作簿，这应该保留原始工作表的格式。这里的代码更新了注释：

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

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

2 个答案: