1
votes

New VBA user here, thank you for your patience. I want to copy and paste as values a range from a single closed worksheet to an active worksheet. Specifically, I want to use VBA in an active workbook to copy range A1:HW6000 from the "AllData" tab in TOOL.XLSM while TOOL.XLSM is closed and paste into the active workbook in range A1:HW6000 in the active sheet as values.

I have code that will do this (care of Peh at stackoverflow, thank you Peh!), but the code runs forever (more than 45 minutes), because running the code seems to recalculate both the new workbook and the import workbook at the same time, and the import workbook (TEST.xslm) is very large. I am running on a Mac. Here is the code I currently have:

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

Can I integrate the following bits of code to turn off the calculation during the import process? If so, how exactly? I cannot figure it out:

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

Is there anything else I can do? Thank you tremendously for your time.

1
45 minutes. that is impressive! Why do you need another instance of Excel? Why do you need exactly 6000 rows? What is in the other rows in the destination worksheet? What is in the other columns? What is in the copied data - is it data? - that requires both workbooks to recalculated for 45 minutes?Variatus
Insert those three lines right after Set wbImport = .... Do remember to turn them back to true at the end of your code.Luuklag
At which line does it take the time? When the workbook is opened or at the copy paste? Run the macro step by step to figure out. Does it need that time also when you open that file into excel as usual?Pᴇʜ
You should use array or vectors it will be a lot faster. or if you what I ca give you some code that will copy the entire sheet from one excel to another.Ionut

1 Answers

-1
votes

here it's a function that use vectors for copy data from one excel to another, make sure to assign this to a button and into a cell to specify the path. create a module named : "FUNCTIONS" and paste this over there :

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

After you are done create 2 sub in which write this :

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