Excel复制/粘贴值/注释/格式间歇性VBA故障

我有一个非常大的Excel文件，其中包含14k+行代码和320+张工作表

该文件的VBA从其他Excel电子表格导入数据，进行一些计算并“导出”结果

“导出”包括打开一个新工作簿，复制这些工作表的值、格式、注释和颜色，然后保存新文件

作为代码的一部分，我编写了一些检查数据是否已粘贴的内容。只是一个非常简单的例子：

If Range("A2").Value <> True Then
    'error has occured with export
    MsgBox "error", vbCritical, "AURORA Model: Error #MU-ID: Unable to Export Datafile"
    Exit Sub
End If

如果范围（“A2”）。则值为真
'导出时发生错误
MsgBox“错误”，vbCritical，“极光模型：错误#MU-ID:无法导出数据文件”
出口接头
如果结束

正如我所说，这个错误是间歇性的，我似乎无法找出它的原因。我想这是记忆的问题。有什么建议吗

下面是代码中有趣的部分：

Sub ExportData(filename As String, FileLocation As String, export_reason As String)

'
' this macro copys over the values and comments from the model
' this is run by clicking the "butExport" button on the userform
'

Dim sheets_all As Integer
Dim sheets_cycle As Integer
Dim sheet_name As String

Dim sheet_colour As Long

Dim wBook1 As String
Dim wBook2 As String
    'wBook1 is AuRORA
    wBook1 = ThisWorkbook.Name

    Application.SheetsInNewWorkbook = 1
    Workbooks.Add
    'wBook2 is what will be the new datafile
    wBook2 = ActiveWorkbook.Name

    'activate the Aurora Model
    Windows(wBook1).Activate
    'count the number of sheet in the model
    sheets_all = Sheets.Count

    Sheets("l_ERROR_IPT").ListObjects("tbl_ERROR_IPT").Range.AutoFilter Field:=3
    Sheets("l_MRUN").ListObjects("tbl_MRUN").Range.AutoFilter Field:=2, _
        Criteria1:=""

    On Error Resume Next
    For sheets_cycle = 1 To sheets_all

        sheet_name = Sheets(sheets_cycle).Name

        Application.StatusBar = _
            "Running Macro. Exporting data " & sheets_cycle _
            & " (" & sheet_name & ") of " & sheets_all & " (" & Round(sheets_cycle / sheets_all * 100, 1) & "%)"

        'if the cycling sheet name begins with s, i, n, l, u, c, o, p or d then...
        If Mid(sheet_name, 1, 2) = "i_" Or Mid(sheet_name, 1, 2) = "u_" _
            Or Mid(sheet_name, 1, 2) = "c_" Or Mid(sheet_name, 1, 2) = "o_" _
            Or Mid(sheet_name, 1, 2) = "p_" Or Mid(sheet_name, 1, 2) = "d_" Or _
            Mid(sheet_name, 1, 2) = "l_" Or Mid(sheet_name, 1, 2) = "s_" Or _
            Mid(sheet_name, 1, 2) = "n_" Then
                Sheets(sheets_cycle).Select
                'if it's not a "p_" sheet then show all data
                If Mid(sheet_name, 1, 2) <> "p_" Then ActiveSheet.ShowAllData
                'copy all cells
                Range("A1:AZ2000").Copy
                sheet_colour = Sheets(sheets_cycle).Tab.Color
                'activate datafile
                Windows(wBook2).Activate
                'paste values and comments
                With Range("A1")
                    .PasteSpecial xlPasteValues
                    .PasteSpecial xlPasteComments
                    .PasteSpecial xlPasteFormats
                End With
                'rename sheet with newly pasted data in datafile
                ActiveSheet.Name = sheet_name
                ActiveSheet.Tab.Color = sheet_colour
                'check that cell "A2" = "TRUE" otherwise there has been an error with the export
                If Range("A2").Value <> True Then
                    'error has occured with export
                    MsgBox "error", vbCritical, "AURORA Model: Error #MU-ID: Unable to Export Datafile"
                    Windows(wBook1).Activate
                    Exit Sub
                End If
                'add another sheet
                Sheets.Add After:=Sheets(Sheets.Count)
                Windows(wBook1).Activate
        End If
    Next sheets_cycle

    'Delete the last sheet and select the front sheet (d_file_info_sheet)
    Windows(wBook2).Activate
    Sheets(Sheets.Count).Delete
    Sheets(1).Select

    'save datafile with a random password
    ActiveWorkbook.SaveAs filename:=FileLocation & filename, FileFormat:=50, WriteResPassword:= _
        funcRandNumbersLarge, ReadOnlyRecommended:=True

    ActiveWorkbook.Close
    Sheets(1).Select

    MsgBox "Datafile exported and saved as """ & ReconciliationModel.labExportFile.Caption _
        & """. Please check that this has been saved correctly before closing the exported datafile (which has been left open).", vbOKOnly, "AURORA Model: Datafile exported"

子导出数据（文件名为字符串，文件位置为字符串，导出原因为字符串）
'
'此宏复制模型中的值和注释
'这是通过单击userform上的“butExport”按钮来运行的
'
将所有图纸均设置为整数
以整数形式显示每个循环的尺寸
尺寸表名称为字符串
暗淡的纸张颜色与长的一样
将wBook1设置为字符串
作为字符串的Dim wBook2
wBook1是极光
wBook1=此工作簿。名称
Application.wWorkbook=1
工作手册。添加
“wBook2将是新的数据文件
wBook2=ActiveWorkbook.Name
“激活极光模型
Windows（wBook1）。激活
'计算模型中的图纸数量
工作表\u全部=工作表。计数
图纸（“l_错误_IPT”）。列表对象（“tbl_错误_IPT”）。范围。自动筛选字段：=3
工作表（“l_MRUN”）.ListObjects（“tbl_MRUN”）.Range.AutoFilter字段：=2_
准则1:“”
出错时继续下一步
对于图纸\u循环=1到图纸\u全部
图纸名称=图纸（图纸循环）。名称
Application.StatusBar=_
“正在运行宏。导出数据”&工作表\u循环_
&“（&sheet\u name&”）的“&sheet\u all&”（“&Round（sheets\u cycle/sheets\u all*100,1）&%”）
'如果循环表名称以s、i、n、l、u、c、o、p或d开头，则。。。
如果Mid（图纸名称，1，2）=“i”或Mid（图纸名称，1，2）=“u”_
或Mid（图纸名称，1,2）=“c”或Mid（图纸名称，1,2）=“o”_
或Mid（图纸名称，1，2）=“p”或Mid（图纸名称，1，2）=“d”或_
中间（图纸名称，1，2）=“l”或中间（图纸名称，1，2）=“s”或_
中间（图纸名称，1，2）=“n”然后
工作表（工作表循环）。选择
'如果不是“p___）表，则显示所有数据
如果Mid（工作表名称，1，2）“p”，则ActiveSheet.ShowAllData
'复制所有单元格
范围（“A1:AZ2000”）。副本
板材颜色=板材（板材循环）。选项卡颜色
'激活数据文件
Windows（wBook2）。激活
'粘贴值和注释
带范围（“A1”）
.Paste特殊XLPaste值
.Paste特别评论
.Paste特殊XLPaste格式
以
'使用数据文件中新粘贴的数据重命名工作表
ActiveSheet.Name=工作表\工作表名称
ActiveSheet.Tab.Color=工作表颜色
'检查单元格“A2”=“TRUE”，否则导出时出错
如果范围（“A2”）。值为真，则
'导出时发生错误
MsgBox“错误”，vbCritical，“极光模型：错误#MU-ID:无法导出数据文件”
Windows（wBook1）。激活
出口接头
如果结束
“再加一张
Sheets.Add After:=工作表（Sheets.Count）
Windows（wBook1）。激活
如果结束
下一周期
'删除最后一张图纸并选择前一张图纸（d_文件\u信息\u图纸）
Windows（wBook2）。激活
工作表（工作表.计数）.删除
第（1）页。选择
'使用随机密码保存数据文件
ActiveWorkbook.SaveAs文件名：=文件位置和文件名，文件格式：=50，WriteResPassword:=_
funcRandNumbersLarge，ReadOnlyRecommended:=真
活动工作簿。关闭
第（1）页。选择
MsgBox“数据文件导出并另存为”“”&协调模型.labExportFile.Caption_
&“。在关闭导出的数据文件（保持打开状态）之前，请检查此文件是否已正确保存。”，vbOKOnly，“AURORA模型：导出的数据文件”

我开始为这个问题发火，所以任何建议都是非常受欢迎的

谢谢

---

Tom

由于要复制大量数据，因此需要清除内存。粘贴值之后

请在专行末尾使用以下代码

Application.cutcopymode = False
Application.cutcopymode = True

---

尝试在代码中使用“Activesheet.Range”而不是Range

尝试将每个样式循环的工作表循环更改为

。实际错误是什么？扔哪条线？如果这个
范围（“A2”）。值为真，那么你想要实现什么呢？
？嗨，如果我去掉了“在错误恢复下一步”这一行，那么错误就会在“.pasteValues”上抛出。我得到的消息是“运行时错误'1004'范围类的特殊方法失败”。问题是，如果我移动“黄色执行行”的东西，使其重新复制，然后再次尝试粘贴（用F8步进），效果会很好。我继续运行它，几页后它又失败了。正如我之前所说，它是间歇性的——错误并不总是在同一张纸上。“If Range（“A2”）.Value True Then”的目的是捕获那些失败的粘贴。Hi@SO。不幸的是，每个

循环的

不是很好，因为我有多达50列的工作表，行多达1500行，所以对每个单元格进行
，在75000个单元格上进行
，在300多张工作表上进行值计算，