关于excel：将工作表移动到新创建的

Moving Worksheets to Newly Created & Version Changed Workbook VBA

我正在继续处理从大型机中提取的数据。这些数据主要是字母数字，并且是在过去努力的基础上构建功能的延续。移动工作表的循环是基于此 SO 文章中讨论的函数创建的。

我已查阅此 SO 文章并独立测试了此类功能的一般形式，但此类代码在此特定情况下失败，可能是由于版本问题或我引用新工作簿的方式。

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

代码如下：

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131

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"运行时错误：

1	IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count

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

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

这个：

IndividualWorkSheet.Move After:=NewWorkBook1.Sheets.Count

只指定在同一个工作簿中移动工作表(如果 NewWorkBook1 的工作表比其父工作簿多，则会出错)

也许可以试试：

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