将大型活动工作表从closures的工作簿复制到活动工作簿，停止计算，Excel VBA，Mac OSX

新的VBA用户在这里，感谢您的耐心等待。 我想复制和粘贴作为值从单个封闭的工作表到活动工作表的范围。 具体来说，我想在活动工作簿中使用VBA从TOOL.XLSM中的“AllData”选项卡复制范围A1：HW6000，同时closuresTOOL.XLSM，并将活动工作表中的范围A1：HW6000中的活动工作簿粘贴为值。

我有代码，将执行此操作（关心裴在堆栈溢出，谢谢你！），但代码永远运行（超过45分钟），因为运行代码似乎重新计算新的工作簿和导入工作簿在相同时间，而导入工作簿（TEST.xslm）非常大。 我在Mac上运行。 这是我现在的代码：

Sub ImportData() Dim App As New Excel.Application 'create a new (hidden) Excel ' remember active sheet Dim wsActive As Worksheet Set wsActive = ThisWorkbook.ActiveSheet ' open the import workbook in new Excel (as read only) Dim wbImport As Workbook Set wbImport = App.Workbooks.Open(Filename:="/Users/cwight/Desktop/TOOL.xlsm", UpdateLinks:=True, ReadOnly:=True) 'copy the data of the import sheet wbImport.Worksheets("AllDATA").Range("A1:HW6000").Copy wsActive.Range("A1").PasteSpecial Paste:=xlPasteFormats 'paste formats wsActive.Range("A1").PasteSpecial Paste:=xlPasteValues 'paste values App.CutCopyMode = False 'clear clipboard (prevents asking when wb is closed) wbImport.Close SaveChanges:=False 'close wb without saving App.Quit 'quit the hidden Excel End Sub 

在导入过程中，我可以整合下列代码来closures计算吗？ 如果是的话，究竟如何？ 我想不明白：

  Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayStatusBar = False 

还有什么我可以做的吗？ 非常感谢您的时间。

Answer 1

这里是一个使用向量从一个Excel复制数据的function，确保将其分配给一个button，并将其分配给一个单元格以指定path。 创build一个名为“FUNCTIONS”的模块并粘贴在那里：

 Function range_to_variant(variant_arr As Variant, sheet As Worksheet, first_range As String, last_column As String, last_row_column As String) variant_arr = sheet.Range(first_range & ":" & last_column & sheet.Cells(sheet.Rows.Count, last_row_column).End(xlUp).Row).Value End Function Function array_to_range(variant_arr As Variant, sheet As Worksheet, first_range As String) 'example ' Call array_to_range(new_variant, Worksheets("Sheet1"), "1.1") Dim split_arr() As String split_arr = Split(first_range, ".") Dim range1 As String Dim range2 As String Dim range3 As String Dim range4 As String range1 = Replace(sheet.Cells(CInt(split_arr(0)), CInt(split_arr(1))).Address, "$", "") range2 = Replace(sheet.Cells(CInt(split_arr(0)) + UBound(variant_arr, 1) - 1, CInt(split_arr(1)) + UBound(variant_arr, 2) - 1).Address, "$", "") sheet.Range(range1 & ":" & range2).Value = variant_arr sheet.Range(range1 & ":" & range2).Columns.AutoFit End Function 

完成后创build2个子，在其中写入：

 Sub select_fle2() Call Select_file("b10", "xlsm") End Sub Sub Run() Dim xl As New Excel.Application xl.Workbooks.Open (Worksheets("MAIN").Range("B7").Value) xl.Visible = False Dim raw_data As Variant Call range_to_variant(raw_data, xl.Worksheets("your_sheet_name"), "A1", "HW", "A") xl.Quit Set xl = Nothing ThisWorkbook.Worksheets("sheet_paste").Columns("A:HW").ClearContents Call array_to_range(raw_data, Worksheets("sheet_paste"), "1.1") End sub