copy data without  open data source file

Muhammad Aayan
Muhammad Aayan used Ask the Experts™
on
Hi Sir / Madam,

i have worked on the code to copy the data form the other files, which works fine though.
but the problem when run this coed it go back the files & then copy the data, when & if the file are huge & net work is slow if got stuck.
i m need help to update this code to copy data without open the data sources files.

Dim WBSurc As Workbook, WBDest As Workbook, flpath As String
Dim WSSurc As Worksheet, WSDest As Worksheet
Dim nOpenWorkbook As Long

Application.ScreenUpdating = False

Sheet1.Unprotect Password:="comb2018"

'to Open SR workbook to copy:
'F3456
flpath = "\\Group\DEPT\GPO\ F3456\Sourcing List"
Set WBSurc = Workbooks.Open(flpath & "\PKG 2 Rev B.xlsb")
nOpenWorkbook = 200
Set WBDest = ThisWorkbook
Set WSSurc = WBSurc.Worksheets("Comb List")
Set WSDest = WBDest.Worksheets("Comb Data")


'copy from SR source book:
WSSurc.Range("A5:AQ2178").Copy
WSDest.Range("A6").PasteSpecial xlPasteValues

'close source book:
Application.DisplayAlerts = False
WBSurc.Close SaveChanges:=False
Application.DisplayAlerts = True


'D7567
Application.ScreenUpdating = False
flpath = "\\Group\DEPT\GPO\ D7567\Sourcing List
Set WBSurc = Workbooks.Open(flpath & "\PKG 1.xlsb")
Set WBDest = ThisWorkbook
Set WSSurc = WBSurc.Worksheets("Comb List")
Set WSDest = WBDest.Worksheets("Comb Data")
nOpenWorkbook = 200

'copy from SR source book:
WSSurc.Range("A5:AQ2178").Copy
WSDest.Range("A2183").PasteSpecial xlPasteValues


'close source book:
Application.DisplayAlerts = False
WBSurc.Close SaveChanges:=False
Application.DisplayAlerts = True

'W7234
Application.ScreenUpdating = False
flpath = "\\Group\DEPT\GPO\ W7234\Sourcing List”
Set WBSurc = Workbooks.Open(flpath & "\PKG 4.xlsb")
Set WBDest = ThisWorkbook
Set WSSurc = WBSurc.Worksheets("Comb List")
Set WSDest = WBDest.Worksheets("Comb Data")
nOpenWorkbook = 200

'copy from SR source book:
WSSurc.Range("A5:AQ2178").Copy
WSDest.Range("A4361").PasteSpecial xlPasteValues


'close source book:
Application.DisplayAlerts = False
WBSurc.Close SaveChanges:=False
Application.DisplayAlerts = True


If WBDest.Worksheets("Comb Data").FilterMode Then
        WBDest.Worksheets("Comb Data").ShowAllData
        End If

Sheet1.Protect Password:="comb2018", AllowFiltering:=True, DrawingObjects:=True, AllowFormattingCells:=True, AllowFormattingColumns:=True

MsgBox ("Data Copied")
Application.ScreenUpdating = True

End Sub

Open in new window


Thanks,

Aayan
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Roy CoxGroup Finance Manager

Commented:
Have you tried the get data feature of Excel. Located in the Data Tab on the right ids get & Transform data. You can import data from other workbooks without VBA.

Author

Commented:
no Sir, but as per my code i need to take data from the network & user is file, even thought are working on the same file.
& problem is that when i run the macro, it open the file in my computer as well which slow the process..
Roy CoxGroup Finance Manager

Commented:
Try my suggestion.
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

Author

Commented:
ok sir will try, but i never used, can u explain how to use that?
Roy CoxGroup Finance Manager

Commented:
It's quite simple, your data to import must be in a Table layout.

Basically, open the Data Tab in the Ribbon. At the extreme left of the Tab is Get data which when you click the button displays a drop down menu, select From File then Excel Workbook. Next you can select the workbook to import from and then a list of available data to import from the selected workbook.

This explains the method

Connect to another workbook

Author

Commented:
Hi Roy,

thanks for advice, i tried & its woks fine once we refresh.
but problem is its not working when the source file is on Share mode & those shd be always on share-mode.
with the vb code, can get the data even if the file are on the share mode but problem is that will open the file & then the whole process get slow.
Roy CoxGroup Finance Manager

Commented:
Sharing workbooks is not a good idea. Excel is not really deigned properly for sharing unless you have Office 2016 which has a Colloborate feature.
You can create links from the closed workbook, to a sheet in the destination workbook.
Then copy the data from that sheet.
The principle to create the links in VBA is this

wsData.Range("A5:AQ2178").FormulaR1C1 = "='" + flpath + "\[" + fName + "]" & sName & "'!RC"

wsData is the sheet with the links
flpath is the path to the file, "\\Group\DEPT\GPO\ W7234\Sourcing List”
fName is the file name, "PKG 4.xlsb"
sName is the sheet name, "Comb List"

Clear the link sheet when done.

If there are blank cells in the range, they will be imported as 0, and if that is a problem the formula must be tweaked to handle that.

Author

Commented:
Hi Ejgil,

Thanks for response, i tried to use
wsData.Range("A5:AQ2178").FormulaR1C1 = "='" + flpath + "\[" + fName + "]" & sName & "'!RC"

Open in new window

 but i m getting compile error,
may i request to you if you can update in the below code?

  
Dim WBSurc As Workbook, WBDest As Workbook, flpath As String
Dim WSSurc As Worksheet, WSDest As Worksheet
Dim nOpenWorkbook As Long

Application.ScreenUpdating = False

Sheet1.Unprotect Password:="comb2018"

'to Open SR workbook to copy:
'F3456
flpath = "\\Group\DEPT\GPO\ F3456\Sourcing List"
Set WBSurc = Workbooks.Open(flpath & "\PKG 2 Rev B.xlsb")
nOpenWorkbook = 200
Set WBDest = ThisWorkbook
Set WSSurc = WBSurc.Worksheets("Comb List")
Set WSDest = WBDest.Worksheets("Comb Data")


'copy from SR source book:
WSSurc.Range("A5:AQ2178").Copy
WSDest.Range("A6").PasteSpecial xlPasteValues

'close source book:
Application.DisplayAlerts = False
WBSurc.Close SaveChanges:=False
Application.DisplayAlerts = True
 

Open in new window


Thank in advance
M Aayan

Author

Commented:
Hi Roy,

yeah i know but we have to keep this file in sharing for multiple users to work at the same time, & i hv office 2013.
Roy CoxGroup Finance Manager

Commented:
A better way would be to consider replacing the workbook with an Access Database.

There is a method using ADO described here

Import data from a closed workbook (ADO) using VBA in Microsoft Excel
You get the compile error because the variables are not defined.

Make a sheet  to import the data to, and name it DataImport.
The sheet can be hidden if you don't want to see it.

Then try this
Dim flpath As String, fName As String, sName As String
Dim WSSurc As Worksheet, WSDest As Worksheet

Application.ScreenUpdating = False

flpath = "\\Group\DEPT\GPO\ F3456\Sourcing List"
fName = "PKG 2 Rev B.xlsb"
sName = "Comb List"

Set WSSurc = ThisWorkbook.Worksheets("DataImport")
Set WSDest = ThisWorkbook.Worksheets("Comb Data")

WSSurc.Range("A5:AQ2178").FormulaR1C1 = "='" + flpath + "\[" + fName + "]" & sName & "'!RC"

'copy from source sheet
WSSurc.Range("A5:AQ2178").Copy
WSDest.Range("A6").PasteSpecial xlPasteValues
Application.CutCopyMode = False

WSSurc.Cells.Clear

Open in new window

Author

Commented:
Hi Ejgil,

Thanks for the response, i tried but i m still getting of "Subscript out of range" on

 
 Set WSSurc = ThisWorkbook.Worksheets("DataImport") 

Open in new window

& even after changes with
 
 Set WSSurc = ThisWorkbook.Worksheets("Comb List") 

Open in new window



Thx
"Subscript out of range" mean "The sheet does not exist".
Did you make the sheet with the name DataImport in the destination workbook?

Author

Commented:
Thanks Sir, now its working after changing the name of the Destination workbook's worksheet,

but a small query sir, Destination workbook will be
 Set WSDest = ThisWorkbook.Worksheets("Comb Data")

Open in new window

& this should be
 Set WSSurc = ThisWorkbook.Worksheets("DataImport") 

Open in new window

source workbook isn't?

& even on above of the code we have defined source workbook in flpath, fName & sName but then how its reading the source's worksheet  as destination's worksheet.

thx,
Aayan
I don't understand what the problem is.

Source workbook is fName, and the source worksheet in source workbook is sName.
That is imported to worksheet WSSurc (DataImport) in the destination workbook, and data copied from that worksheet to destination worksheet WSDest (Comb Data).

Then for the second import, you can change flpath, fName and paste destination range from A6 to A4361.
sName and Range("A5:AQ2178") are the same in both source workbooks.

Then it will be this for both workbooks
Option Explicit

Sub ImportData()
    Dim flpath As String, fName As String, sName As String
    Dim WSSurc As Worksheet, WSDest As Worksheet
    
    Application.ScreenUpdating = False
    
    Set WSSurc = ThisWorkbook.Worksheets("DataImport")
    Set WSDest = ThisWorkbook.Worksheets("Comb Data")
    
    'Get data from first workbook
    flpath = "\\Group\DEPT\GPO\ F3456\Sourcing List"
    fName = "PKG 2 Rev B.xlsb"
    sName = "Comb List"
    
    WSSurc.Range("A5:AQ2178").FormulaR1C1 = "='" + flpath + "\[" + fName + "]" & sName & "'!RC"
    
    WSSurc.Range("A5:AQ2178").Copy
    WSDest.Range("A6").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    'Get data from second workbook
    flpath = "\\Group\DEPT\GPO\ W7234\Sourcing List"
    fName = "PKG 4.xlsb"
    sName = "Comb List"
    
    WSSurc.Range("A5:AQ2178").FormulaR1C1 = "='" + flpath + "\[" + fName + "]" & sName & "'!RC"
    
    WSSurc.Range("A5:AQ2178").Copy
    WSDest.Range("A4361").PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    'Clear import data sheet
    WSSurc.Cells.Clear

End Sub

Open in new window

Author

Commented:
sorry for late response,

Thank you Ejgil for your help, it working  fine..
& Thx Roy for your help too

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial