尝试复制工作表并粘贴到一个新的excel文件,继续获取空工作表

iugsix8n 于 12个月前发布在其他

关注(0)|答案(2)|浏览(109)

请参阅下面的代码，但正在发生的事情令人困惑。我已经看了这里的其他问题，并尝试了不同的东西，看看我是否可以让它工作，但我不能。我得到了要创建的新文件，但它只是空的Sheet1（2）。（我不想要，我想它粘贴到新文件的Sheet1。）但目前的格式是，我想复制Sheet1从旧文件，只是粘贴到新文件的Sheet1工作表的所有内容。如果你看到代码中的任何错误，请告诉我。谢谢

Sub saveResult()
Dim mywb As Workbook
Dim Save_Path As String
Dim sht As Worksheet

Set sht = Worksheets("Macro")
Save_Path = sht.Cells(5, 7).Value

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

todayyear = Format(Date, "YYYY")
filemonth = Format(Date, "mm")
fileyear = Right(todayyear, 2)

Set mywb = Workbooks.Add
    Sheets("Sheet1").Copy Before:=mywb.Sheets("Sheet1")
    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

excel

来源：https://stackoverflow.com/questions/77245160/trying-to-copy-worksheet-and-paste-into-a-new-excel-file-keep-getting-an-empty

2条答案

按热度按时间

fxnxkyjh1#

最佳实践是为任何Worksheet指定父Workbook。

Set mywb = Workbooks.Add
Sheets("Sheet1").Copy ...

被隐式

Set myWb = Workbooks.Add
ActiveWorkbook.Sheets("Sheet1").Copy ...

由于Workbooks.Add激活了新工作簿，因此这相当于

Set myWb = Workbooks.Add
myWb.Sheets("Sheet1").Copy ...

它复制一张白纸。
更好的是，不带任何参数的Worksheet.Copy会创建一个新的工作簿，因此将

Set mywb = Workbooks.Add
    Sheets("Sheet1").Copy Before:=mywb.Sheets("Sheet1")
    mywb.SaveAs Save_Path & "\FinalProduct " & filemonth & fileyear & ".xlsx"

与

ThisWorkbook.Worksheets("Sheet1").Copy
ActiveWorkbook.SaveAs Save_Path & "\FinalProduct " & filemonth & fileyear & ".xlsx"

赞(0）回复(0）举报 12个月前

fwzugrvs2#

我已经修改了你的代码来解决这个问题。我还重命名了一些对象，使其更容易理解：

Sub saveResult()

    ' declarations
    Dim wbSource As Workbook, wsSource As Worksheet
    Dim wbDestination As Workbook, wsDestination As Worksheet
    Dim Save_Path As String
    
    ' set source
    Set wbSource = ActiveWorkbook
    Set wsSource = wbSource.Worksheets("Sheet1")
    
    ' read save path from Macro sheet
    Save_Path = wbSource.Worksheets("Macro").Cells(5, 7).Value
    
    ' dates for filename
    todayyear = Format(Date, "YYYY")
    filemonth = Format(Date, "mm")
    fileyear = Right(todayyear, 2)
    
    ' disable things
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False
    Application.DisplayAlerts = False
    
    ' create new workbook
    Set wbDestination = Workbooks.Add
    
    ' copy wsSource to wbDestination, before first sheet, making it first sheet
    wsSource.Copy Before:=wbDestination.Sheets(1)
    
    ' remove all sheets in wbDestination other than copied sheet
    For Each ws In wbDestination.Worksheets
        If ws.Index > 1 Then ws.Delete
    Next
    
    ' rename remaining sheet
    wbDestination.Sheets(1).Name = "Sheet1"
    
    ' save wbDestination
    wbDestination.SaveAs Save_Path & "\FinalProduct " & filemonth & fileyear & ".xlsx"
    wbDestination.Close SaveChanges:=False
    
    ' enable things
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    ActiveSheet.DisplayPageBreaks = False '<< did you mean True?
    Application.DisplayAlerts = True
    
    ' alert user
    MsgBox ("Updated File Generated! Ready for review and upload.")
       
End Sub

赞(0）回复(0）举报 12个月前

我来回答

尝试复制工作表并粘贴到一个新的excel文件,继续获取空工作表

2条答案

相关问题

热门标签

最新问答