I am continuing working with data pulled from a mainframe. The data is largely alphanumeric, and is a continuation of building functionality onto past efforts. The loop in which the sheets are moved was created on the basis of the function discussed in this SO article.
I have consulted this SO article and independently tested the general form of such functionality, but such code is failing in this specific case, perhaps due to version issues or the way I am referencing the new workbook.
I have written a subroutine that shifts worksheets from one workbook to another. It is used in conjunction with a public variable tied to a checkbox, and is intended to provide the user with an easy way to port the form data. The public variable is used in a conditional to call the subroutine if the checkmark is in a checked state.
The code is as follows:
Public Sub MoveSheets()
' This macro moves all sheets but those noted within the If statements,(1)
' (1) which are further nested within the For Each loop.
'See http://msdn.microsoft.com/en-us/library/office/ff198017.aspx for save file format types.
'The file format of this excel macro sheet is 52: xlOpenXMLWorkbookMacroEnabled
'The default save type for the use-case is excel 2003 is compatibility mode.
'The macro is to set the current save type to one compatible with 52.
'In this case, 51: xlOpenXMLWorkbook was selected as the selected type.
'Define Excel Format storage variables.
Dim FileFormatSet As Excel.XlFileFormat
Dim OriginalFileFormatSet As Excel.XlFileFormat
Dim TempFileFormatSet As Excel.XlFileFormat
'Define worksheet/workbook variables.
Dim IndividualWorkSheet As Worksheet
Dim NewWorkBook1 As Workbook
'Set variable to store current time.
Dim CurrentTime As Date
'The original file format.
OriginalFileFormatSet = Application.DefaultSaveFormat
'The file format to be used at the end of the procedure after all is said and done.
FileFormatSet = OriginalFileFormatSet
'The currently desired file format.
TempFileFormatSet = xlOpenXMLWorkbook
'The currently desired file format set as the set default.
Application.DefaultSaveFormat = TempFileFormatSet
'Disable application alerts. Comment the line below to display alerts (2)
'(2) in order to help check for errors.
Application.DisplayAlerts = False
'Save new workbook "NewWorkBook" as default file format.
Workbooks.Add.SaveAs Filename:="NewWorkBook", FileFormat:=Application.DefaultSaveFormat
'Set variable to new workbook "NewWorkBook", which is in .xlsx format.
Set NewWorkBook1 = Workbooks("NewWorkBook.xlsx")
'Activate Macro Window.
Windows("ShifterMacro.xlsm").Activate
'For each worksheet, shift it to the workbook "NewWorkBook" if (3)
'(3) it fails outside the criteria set listed below.
For Each IndividualWorkSheet In ThisWorkbook.Worksheets
If IndividualWorkSheet.Name <> "Sheet1" And IndividualWorkSheet.Name <> "Criteria" And _
IndividualWorkSheet.Name <> "TemplateSheet" And IndividualWorkSheet.Name <> "TemplateSheet2" And _
IndividualWorkSheet.Name <> "Instructions" And IndividualWorkSheet.Name <> "Macro1" And _
IndividualWorkSheet.Name <> "DataSheet" Then
'Select each worksheet.
IndividualWorkSheet.Select
'Shift the worksheetover to the new workbook.
'****NOTE: THIS CODE CURRENTLY RESULTS IN A '1004' RUN-TIME ERROR.****
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count
End If
Next
'An ugly set of If Then statements to clean the new workbook (4)
'(4) of its previous sheets, assuming entries are to be made.
If NewWorkBook1.Sheets.Count > 1 Then
NewWorkBook1.Sheets("Sheet1").Delete
End If
If NewWorkBook1.Sheets.Count > 1 Then
NewWorkBook1.Sheets("Sheet2").Delete
End If
If NewWorkBook1.Sheets.Count > 1 Then
NewWorkBook1.Sheets("Sheet3").Delete
End If
'********** CODE CHECKED BUT UNTESTED WITHIN THESE BOUNDARIES **********
'Activate the Window for the new workbook if it is inactive.
Windows("NewWorkBook.xlsx").Activate
'If the number of sheets are greater than 1... (5)
If Sheets.Count > 1 Then
'(6) The time value is parsed to remove unusual characters, following (5)
'(6) the logic of this SO article: https://stackoverflow.com/questions/11364007/save-as-failed-excel-vba.
'Formatted current time as per http://www.mrexcel.com/forum/excel-questions/273280-visual-basic-applications-format-now-yyyymmddhhnnss.html
CurrentTime = Format(Now(), "yyyy-mm-dd-hh-nn-ss")
'(5) Then go ahead and save the file with the current date/time information.
NewWorkBook1.SaveAs Filename:="Form_Data_" & Now, FileFormat:=Application.DefaultSaveFormat
End If
'Set SaveChanges = True, as per https://stackoverflow.com/questions/9327613/excel-vba-copy-method-of-worksheet-fails
ActiveWorkbook.Close SaveChanges:=True
'********** END CODE BOUNDARY **********
'Activate the Window for the Macro.
Windows("ShifterMacro.xlsm").Activate
'Activate a specific sheet of the Macro.
ActiveWorkbook.Sheets("Instructions").Activate
'Change Display Alerts back to normal.
Application.DisplayAlerts = True
'Reset the view for the original data sheet.
With Sheets("Sheet1")
'For when this process is repeated.
If .FilterMode Then .ShowAllData
End With
'Return the Default save format to the original file format.
Application.DefaultSaveFormat = FileFormatSet
End Sub
The code fails at line 62, and results in a ‘1004’ Run-Time error:
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count
The worksheet referenced holds the correct test value of ‘100-AAA’. The Sheets.Count is equal to 3. The NewWorkBook1 variable holds the value NewWorkBook.xslx. The path of the generated workbook “NewWorkBook.xslx” is the same as the macro workbook. My version of excel is 2007, although the default for my users is 2003, even though they have the capacity and the installation for 2007.
Why is this run-time error with my Move occuring, and how do I correct this error in order to get my worksheets over to the newly generated workbook?
This:
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Countjust specifies to move the sheet within the same workbook (and it will error if NewWorkBook1 has more sheets than its parent workbook)
Maybe try:
IndividualWorkSheet.Move After:=NewWorkBook1.Sheets(NewWorkBook1.Sheets.Count)