Excel复制/粘贴值/注释/格式间歇性VBA失败

时间:2015-02-17 09:01:08

标签: excel vba excel-vba copy-paste

我有一个非常大的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

正如我所说,这个错误是间歇性的,我似乎无法解决导致它的原因。我认为这是一个记忆的事情。有什么建议吗?

以下是代码的有趣部分:

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"

我开始在这个问题上脱掉头发,所以非常欢迎任何意见或建议!

由于

汤姆

1 个答案:

答案 0 :(得分:0)

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

请在pastespecial line

末尾使用以下代码
<div id="elementbox"></div>

<span id="message"></span>

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