Microsoft Office Forums

Go Back   Microsoft Office Forums > Microsoft Excel > Excel Programming

Reply
 
LinkBack Thread Tools Display Modes
  #1  
Old 09-23-2017, 05:48 AM
Filip88 Filip88 is offline Windows 10 Office 2016
Novice
 
Join Date: Jan 2017
Posts: 12
Filip88 is on a distinguished road
Default Data transfer between workbooks


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
Reply With Quote
  #2  
Old 09-23-2017, 08:43 AM
NoSparks NoSparks is offline Windows 7 64bit Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Posts: 404
NoSparks is on a distinguished road
Default

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.
Reply With Quote
  #3  
Old 09-23-2017, 11:07 AM
Filip88 Filip88 is offline Windows 10 Office 2016
Novice
 
Join Date: Jan 2017
Posts: 12
Filip88 is on a distinguished road
Default

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.
Attached Files
File Type: xlsx data.xlsx (162.7 KB, 3 views)
File Type: xlsm makro.xlsm (328.9 KB, 3 views)
Reply With Quote
  #4  
Old 09-23-2017, 01:48 PM
NoSparks NoSparks is offline Windows 7 64bit Office 2010 64bit
Excel Hobbyist
 
Join Date: Nov 2013
Posts: 404
NoSparks is on a distinguished road
Default

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
Reply With Quote
  #5  
Old 09-24-2017, 03:18 AM
Filip88 Filip88 is offline Windows 10 Office 2016
Novice
 
Join Date: Jan 2017
Posts: 12
Filip88 is on a distinguished road
Default

Quote:
Originally Posted by NoSparks View Post
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
Reply With Quote
Reply

Thread Tools
Display Modes


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


All times are GMT -7. The time now is 08:53 PM.


Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2011, Crawlability, Inc.
MSOfficeForums.com is not affiliated with Microsoft