Rebuild a workbook with VBA - vba

Question

I am trying to run the below VBA that I found online. The purpose of the code is to copy the data from all of the worksheets in a workbook to a different workbook. A couple key points:
1) I am trying to copy the data in all worksheets NOT the actual worksheets to the new workbook
2) The macro does a lot: makes sure you have a back-up file; creates a new worksheet (TargetWorkbook) and saves with the source workbook's name; etc. however, the most important part (and where I believe it is erroring) is copying the worksheets
3) I understand what is going on with the code but not savvy enough to make it work.
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
I believe these lines are driving the error:
Windows("TargetWorkbook.xlsx").Activate
ActiveWindow.WindowState = xlNormal
The error I am getting is "Run Time Error 9 - Subscript out of Range"
Any idea on how to fix?

Answer 1

Use Workbooks("TargetWorkbook.xlsx").Activate instead of Windows...

Answer 2

I would recommend to eliminate the activating if the sheet and workbooks; we do not need it. Just referencing the object is enough.
This is an untested code see how it goes you might need to change it a little bit to fit your needs.
Option Explicit
Sub Test()
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"
End Sub
I hope it helps