将旧Excel文件Sheet1内容复制到新文件Sheet1的VBA问题排查

你当前的代码创建新工作簿后，执行Sheets("Sheet1").Copy Before:=mywb.Sheets("Sheet1")会将原工作簿的Sheet1复制到新工作簿默认Sheet1的前面，导致新文件里同时存在空的Sheet1和复制过来的Sheet1(2)，且默认Sheet1没有内容。要实现将原文件Sheet1的所有内容复制到新文件的Sheet1中，需要调整复制逻辑。

方案一：复制源表内容到新工作簿默认Sheet1 #

这种方式直接填充新工作簿的默认Sheet1，保留原工作表的内容、格式和公式：

Sub saveResult()
    Dim mywb As Workbook
    Dim Save_Path As String
    Dim sht As Worksheet
    Dim sourceSht As Worksheet ' 定义源工作表
    
    Set sht = ThisWorkbook.Worksheets("Macro")
    Save_Path = sht.Cells(5, 7).Value
    Set sourceSht = ThisWorkbook.Sheets("Sheet1") ' 指定原工作簿的Sheet1
    
    ' 关闭不必要的Excel功能提升效率
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    
    ' 生成文件名后缀
    Dim filemonth As String, fileyear As String
    filemonth = Format(Date, "mm")
    fileyear = Right(Format(Date, "YYYY"), 2)
    
    ' 创建新工作簿
    Set mywb = Workbooks.Add
    
    ' 将源工作表的所有内容复制到新工作簿的Sheet1
    sourceSht.UsedRange.Copy Destination:=mywb.Sheets("Sheet1").Range("A1")
    
    ' 保存新文件
    mywb.SaveAs Save_Path & "\FinalProduct " & filemonth & fileyear & ".xlsx"
   
    ' 关闭新工作簿
    mywb.Close SaveChanges:=False
    
    ' 恢复Excel功能
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = False

    MsgBox "Updated File Generated! Ready for review and upload."
End Sub

修改说明 #

• 新增sourceSht变量明确指向原工作簿的Sheet1，避免依赖ActiveSheet导致的潜在错误
• 替换原复制工作表的代码为复制已使用区域到新工作簿的Sheet1，直接填充默认Sheet1的内容，不会生成Sheet1(2)
• 优化变量声明，所有变量提前声明，符合VBA最佳实践

方案二：完整复制源工作表（含列宽、行高、隐藏属性） #

如果需要完全复制源工作表的所有属性（包括列宽、行高、隐藏行/列等），可以用以下方式：

Sub saveResult()
    Dim mywb As Workbook
    Dim Save_Path As String
    Dim sht As Worksheet
    Dim sourceSht As Worksheet
    
    Set sht = ThisWorkbook.Worksheets("Macro")
    Save_Path = sht.Cells(5, 7).Value
    Set sourceSht = ThisWorkbook.Sheets("Sheet1")
    
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    
    Dim filemonth As String, fileyear As String
    filemonth = Format(Date, "mm")
    fileyear = Right(Format(Date, "YYYY"), 2)
    
    ' 创建新工作簿后删除默认的空Sheet1
    Set mywb = Workbooks.Add
    Application.DisplayAlerts = False ' 关闭删除提示
    mywb.Sheets("Sheet1").Delete
    Application.DisplayAlerts = True
    
    ' 将源工作表复制到新工作簿，此时新工作簿的唯一工作表就是Sheet1
    sourceSht.Copy Before:=mywb.Sheets(1)
    
    mywb.SaveAs Save_Path & "\FinalProduct " & filemonth & fileyear & ".xlsx"
   
    mywb.Close SaveChanges:=False
    
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = False

    MsgBox "Updated File Generated! Ready for review and upload."
End Sub

修改说明 #

• 创建新工作簿后删除默认的空Sheet1
• 再将原工作簿的Sheet1复制到新工作簿，这样新工作簿的Sheet1就是源工作表的完整副本，不会出现Sheet1(2)

内容的提问来源于stack exchange，提问作者user22610270