Question

我正在继续处理从大型机中提取的数据。数据主要是alphanumeric，是building functionality onto past efforts的延续。移动工作表的循环是基于此SO article中讨论的功能创建的。

我已经咨询了这个SO article并独立测试了这种功能的一般形式，但是这种代码在这种特定情况下失败了，可能是由于版本问题或我引用新工作簿的方式。

我编写了一个子程序，将工作表从一个工作簿转移到另一个工作簿。它与绑定到复选框的公共变量结合使用，旨在为用户提供一种简单的方法来移植表单数据。如果复选标记处于选中状态，则公共变量在条件中用于调用子例程。

代码如下：

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

代码在第62行失败，导致'1004'运行时错误：

IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count

引用的工作表包含正确的测试值'100-AAA'。 Sheets.Count等于3.NewWorkBook1变量保存值NewWorkBook.xslx。生成的工作簿“NewWorkBook.xslx”的路径与宏工作簿相同。我的excel版本是2007，虽然我的用户的默认版本是2003，即使他们有2007年的容量和安装。

为什么我的Move出现此运行时错误，如何更正此错误以便将工作表转到新生成的工作簿？

Answer 1

此：

IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count

只是指定在同一工作簿中移动工作表（如果NewWorkBook1的工作表多于其工作簿，则会出错）

也许试试：

IndividualWorkSheet.Move After:=NewWorkBook1.Sheets(NewWorkBook1.Sheets.Count)

将工作表移动到新创建的＆amp;版本已更改工作簿VBA

1 个答案: