用VBA重建工作簿

Question

我試圖運行我在網上找到的下面的VBA。代碼的目的是將工作簿中所有工作表中的數據複製到不同的工作簿中。幾個關鍵點：

1）我想複製所有工作表中的數據，而不是實際的工作表到新的工作簿 2）宏做了很多事情：確保你有一個備份文件;創建一個新的工作表（TargetWorkbook）並保存源工作簿的名稱;等等。但是，最重要的部分（我相信它是錯誤的）正在複製工作表 3）我理解代碼中發生了什麼，但沒有足夠的理智來使其工作。

Sub Update_SmartView_Workbook() 
' Copies sheets from a source workbook to new and current Excel target workbook to 
' get rid of the "2003 or earlier backbone" that interferes with SmartView. 
' Keyboard Shortcut: Ctrl+z 
' Copyleft 2013 By MJ Henderson. No rights reserved. Free and worth every penny. 
' User assumes all risk. No warranties implied or otherwise. 

    Dim ConfirmBackup As Integer 
    Dim SourceWorkbook, TargetWorkbook As Workbook 
    Dim SourceWorksheet As Worksheet 
    Dim SourceWorkbookName As String 

    ' User must make a backup before proceeding. 
    ConfirmBackup = MsgBox("Have you made a backup copy of the source file?", vbYesNo, "Confirm Backup") 
    If ConfirmBackup = vbNo Then 
    MsgBox "Try again when you have a backup copy of the source file", vbOKOnly, "Backup Required" 
    Exit Sub 
    End If 
    ' Find and open the source file 
    Application.FindFile 
    Set SourceWorkbook = ActiveWorkbook 
    SourceWorkbookName = ActiveWorkbook.Name 
    SourceWorkbookDirectoryPath = Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - Len(SourceWorkbookName)) 

    ' Create a new target workbook in the same folder as the source workbook 
    Workbooks.Add 
    ActiveWorkbook.SaveAs _ 
    Filename:=SourceWorkbookDirectoryPath & "TargetWorkbook.xlsx", _ 
    FileFormat:=xlOpenXMLWorkbook, ConflictResolution:=True 

    ' Copy each worksheet in SourceWorkbook to TargetWorkbook THIS IS WHERE THE FIX IS NEEDED 
    SourceWorkbook.Activate 
    For Each SourceWorksheet In SourceWorkbook.Worksheets 
    SourceWorksheet.Cells.Copy 
    Windows("TargetWorkbook.xlsx").Activate 
    ActiveWindow.WindowState = xlNormal 
    On Error Resume Next 
    TargetWorkbook.Sheets(SourceWorksheet.Name).Delete 
    Range("A1").Select 
    ActiveSheet.Paste 
    Range("A1").Select 
    ActiveSheet.Name = SourceWorksheet.Name 
    Application.CutCopyMode = cancel 
    Next 

    ' Close SourceWorkbook, rename SourceWorkbook with suffix "_OLD" 
    SourceWorkbook.Activate 
    SourceWorkbook.Saved = True 
    SourceWorkbook.Close SaveChanges:=False 
    Name SourceWorkbookDirectoryPath & SourceWorkbookName As SourceWorkbookDirectoryPath & SourceWorkbookName & "_OLD" 

    ' Global replace to remove any references to old workbook. (Fixes interbook links.) 
    Cells.Replace What:="[" & SourceWorkbookName & "]", _ 
    Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _ 
    False, SearchFormat:=False, ReplaceFormat:=False 

    ' Rename TargetWorkbook as SourceWorkbook's original name, delete TargetWorkbook 
    TargetWorkbook.Activate 
    ActiveWorkbook.SaveAs _ 
    Filename:=SourceWorkbookDirectoryPath & SourceWorkbookName, _ 
    FileFormat:=xlOpenXMLWorkbook 
    ActiveWorkbook.Saved = True 
    ActiveWorkbook.Close SaveChanges:=False 
    Kill SourceWorkbookDirectoryPath & "TargetWorkbook.xlsx" 

End Sub 

我相信這些行所駕駛的錯誤：

Windows("TargetWorkbook.xlsx").Activate 
ActiveWindow.WindowState = xlNormal 

我正的錯誤是「運行時錯誤9 - 標超出範圍」

關於如何解決任何想法？的Windows...

Answer 1

使用Workbooks("TargetWorkbook.xlsx").Activate相反，我會建議以消除激活，如果表和工作簿;我們不需要它。只需引用該對象就足夠了。

這是一個未經測試的代碼，看看它如何進行，您可能需要稍微改變它以適應您的需求。

Option Explicit 

次測試（）

Dim ConfirmBackup As Integer 
Dim SourceWorkbook, TargetWorkbook As Workbook 
Dim SourceWorksheet As Worksheet 
Dim SourceWorkbookName As String 
Dim SourceWorkbookDirectoryPath As String 

' User must make a backup before proceeding. 
ConfirmBackup = MsgBox("Have you made a backup copy of the source file?", vbYesNo, "Confirm Backup") 
If ConfirmBackup = vbNo Then 
    MsgBox "Try again when you have a backup copy of the source file", vbOKOnly, "Backup Required" 
    Exit Sub 
End If 

' Find and open the source file 
Application.FindFile 
Set SourceWorkbook = ActiveWorkbook 
SourceWorkbookName = ActiveWorkbook.Name 
SourceWorkbookDirectoryPath = Left(ActiveWorkbook.FullName, Len(ActiveWorkbook.FullName) - Len(SourceWorkbookName)) 

' Create a new target workbook in the same folder as the source workbook 
Workbooks.Add 
ActiveWorkbook.SaveAs _ 
     Filename:=SourceWorkbookDirectoryPath & "TargetWorkbook.xlsx", _ 
     FileFormat:=xlOpenXMLWorkbook, ConflictResolution:=True 

' Copy each worksheet in SourceWorkbook to TargetWorkbook THIS IS WHERE THE FIX IS NEEDED 
For Each SourceWorksheet In SourceWorkbook.Worksheets 
    TargetWorkbook.Sheets(SourceWorksheet.Name).Delete 
    SourceWorksheet.Copy After:=TargetWorkbook.Sheets(TargetWorkbook.Sheets.Count) 
Next 

' Close SourceWorkbook, rename SourceWorkbook with suffix "_OLD" 
SourceWorkbook.Close SaveChanges:=True 
Name SourceWorkbookDirectoryPath & SourceWorkbookName As SourceWorkbookDirectoryPath & SourceWorkbookName & "_OLD" 

' Global replace to remove any references to old workbook. (Fixes interbook links.) 
Cells.Replace What:="[" & SourceWorkbookName & "]", _ 
       Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _ 
       False, SearchFormat:=False, ReplaceFormat:=False 

' Rename TargetWorkbook as SourceWorkbook's original name, delete TargetWorkbook 
ActiveWorkbook.SaveAs _ 
     Filename:=SourceWorkbookDirectoryPath & SourceWorkbookName, _ 
     FileFormat:=xlOpenXMLWorkbook 
ActiveWorkbook.Close SaveChanges:=True 
Kill SourceWorkbookDirectoryPath & "TargetWorkbook.xlsx" 

末次

我希望它能幫助

Answer 2