用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