Data transfer between workbooks

Filip88 · #1 09-23-2017, 05:48 AM

Hello,

Do you have any hint how to quickly transfer data from one workbook to another?

I have programmed macro to open random workbook, i want to transfer data from that opened workbook into the main workbook (the one i have macro). i have tried to use for loop, but considering thousands rows to be transfered it takes lots of time to finish the macro.

Is here any other way how to transfer data? Or maybe speed up for loop code? It takes 2 minutes to finish the code :s

Thank you for any reply

Filip

NoSparks · #2 09-23-2017, 08:43 AM

Without seeing your macro it's difficult to suggest what might be right for you, but the quickest way to transfer data from one workbook to another is likely populating an array with the source data then writing the array to the destination.

Filip88 · #3 09-23-2017, 11:07 AM

My code

Code:

   Sub data_transfer()
 
    Dim File As String
    Dim xApp As Object
 
    File = Application.GetOpenFilename("Excel Files, *.xls*")
    If File = "False" Then Exit Sub
    Set xApp = CreateObject("Excel.Application")
    xApp.Visible = True
    xApp.Workbooks.Open File
 
 
Dim i As Integer
 
 
For i = 1 To 4000
Workbooks("makro.xlsm").Worksheets("List1").Range("A" & i).Value = xApp.Workbooks(1).Worksheets(1).Range("A" & i).Value
Workbooks("makro.xlsm").Worksheets("List1").Range("B" & i).Value = xApp.Workbooks(1).Worksheets(1).Range("B" & i).Value
Workbooks("makro.xlsm").Worksheets("List1").Range("C" & i).Value = xApp.Workbooks(1).Worksheets(1).Range("C" & i).Value
Next i
 
End Sub

I have main macro and multiple workbooks with data. In main macro i have code to open new workbook and transmit its data by for loop. The thing is that each time i want to transfer data, i might chose different available workbooks.

I have attached two files macro.xlsm and data.xlsx, in the workbook macro is button and code to open file and transmit its data.

NoSparks · #4 09-23-2017, 01:48 PM

Try replacing this part

Code:

Dim i As Integer

For i = 1 To 4000

Workbooks("makro.xlsm").Worksheets("List1").Range("A" & i).Value = xApp.Workbooks(1).Worksheets(1).Range("A" & i).Value
Workbooks("makro.xlsm").Worksheets("List1").Range("B" & i).Value = xApp.Workbooks(1).Worksheets(1).Range("B" & i).Value
Workbooks("makro.xlsm").Worksheets("List1").Range("C" & i).Value = xApp.Workbooks(1).Worksheets(1).Range("C" & i).Value

Next i

with this

Code:

    Dim ray1 As Variant

ray1 = xApp.Workbooks(1).Worksheets(1).UsedRange.Value
Workbooks("makro.xlsm").Worksheets("List1").Range("A1").Resize(UBound(ray1, 1), UBound(ray1, 2)) = ray1

Filip88 · #5 09-24-2017, 03:18 AM

Quote:

Originally Posted by NoSparks

Try replacing this part

Code:

Dim i As Integer
 
For i = 1 To 4000
 
Workbooks("makro.xlsm").Worksheets("List1").Range("A" & i).Value = xApp.Workbooks(1).Worksheets(1).Range("A" & i).Value
Workbooks("makro.xlsm").Worksheets("List1").Range("B" & i).Value = xApp.Workbooks(1).Worksheets(1).Range("B" & i).Value
Workbooks("makro.xlsm").Worksheets("List1").Range("C" & i).Value = xApp.Workbooks(1).Worksheets(1).Range("C" & i).Value
 
Next i

with this

Code:

    Dim ray1 As Variant
 
ray1 = xApp.Workbooks(1).Worksheets(1).UsedRange.Value
Workbooks("makro.xlsm").Worksheets("List1").Range("A1").Resize(UBound(ray1, 1), UBound(ray1, 2)) = ray1

Thank you it works much faster

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How to look up data from one of two workbooks	ColM1	Excel	2	09-10-2016 01:47 AM
Syncing data between two excel workbooks using multiple criteria	Merlot	Excel	2	05-04-2016 06:41 AM
Formulas transferring to other pages in workbooks, but data isn't.	Melissa Ames	Excel	4	03-02-2016 01:58 PM
Pull the data from different closed workbooks paste into master vba	manilara	Excel Programming	2	11-19-2015 08:41 PM
How to transfer my data?	dexoey	Outlook	0	09-15-2012 05:44 AM