Copy from a closed excel file

mtagliaferri

Board Regular
Joined
Oct 27, 2004
Messages
156
I have found through the forum the below code to copy data from a closed excel file to the workbook as soon as this is open, this works fine but it is copying only the column A.

I need to copy columns A to F or ideally specific columns A, B, E and F.
I am strugling to get the code right by selecting the correct columns to copy.

VBA Code:
Option Explicit

Private Sub Workbook_Open()
    Call ReadDataFromCloseFile
End Sub

Sub ReadDataFromCloseFile()
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    
    Dim src As Workbook
    
    Set src = Workbooks.Open("C:\Users\MT\Desktop\MasterFile.xlsx", True, True)
    
    Dim iTotalRows As Integer
    iTotalRows = src.Worksheets("sheet1").Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count
   
    
    Dim iCnt As Integer
    For iCnt = 1 To iTotalRows
        Worksheets("Sheet1").Range("A" & iCnt).Formula = src.Worksheets("Sheet1").Range("A" & iCnt).Formula
    Next iCnt
    
    
    src.Close False
    Set src = Nothing
    
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
See if this does what you are after:-
I am assuming you are copying into the workbook that contains the code.
I don't know why the original code would have used a loop for the rows.
This does all of A:F if you want to do specific columns (A, B, E and F) I would modify it and possibly do a loop on an array of nominated columns.

VBA Code:
Sub ReadDataFromCloseFile()
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
  
    Dim src As Workbook
  
    Set src = Workbooks.Open("C:\Users\MT\Desktop\MasterFile.xlsx", True, True)
  
    Dim iTotalRows As Integer
    iTotalRows = src.Worksheets("sheet1").Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count
 
'   --------------------------------
'   Delete this no need for a loop
'   --------------------------------
'    Dim iCnt As Integer
'    For iCnt = 1 To iTotalRows
'        Worksheets("Sheet1").Range("A" & iCnt).Formula = src.Worksheets("Sheet1").Range("A" & iCnt).Formula
'    Next iCnt

'    Worksheets("Sheet1").Range("A" & iCnt).Formula = src.Worksheets("Sheet1").Range("A" & iCnt).Formula

    ThisWorkbook.Worksheets("Sheet1").Range("A1:F" & iTotalRows).Formula = src.Worksheets("Sheet1").Range("A1:F" & iTotalRows).Formula
  
  
    src.Close False
    Set src = Nothing
  
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Solution
See if this does what you are after:-
I am assuming you are copying into the workbook that contains the code.
I don't know why the original code would have used a loop for the rows.
This does all of A:F if you want to do specific columns (A, B, E and F) I would modify it and possibly do a loop on an array of nominated columns.

VBA Code:
Sub ReadDataFromCloseFile()
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
 
    Dim src As Workbook
 
    Set src = Workbooks.Open("C:\Users\MT\Desktop\MasterFile.xlsx", True, True)
 
    Dim iTotalRows As Integer
    iTotalRows = src.Worksheets("sheet1").Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count
 
'   --------------------------------
'   Delete this no need for a loop
'   --------------------------------
'    Dim iCnt As Integer
'    For iCnt = 1 To iTotalRows
'        Worksheets("Sheet1").Range("A" & iCnt).Formula = src.Worksheets("Sheet1").Range("A" & iCnt).Formula
'    Next iCnt

'    Worksheets("Sheet1").Range("A" & iCnt).Formula = src.Worksheets("Sheet1").Range("A" & iCnt).Formula

    ThisWorkbook.Worksheets("Sheet1").Range("A1:F" & iTotalRows).Formula = src.Worksheets("Sheet1").Range("A1:F" & iTotalRows).Formula
 
 
    src.Close False
    Set src = Nothing
 
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
@Alex Blakenburg Thanks for your help!
 
Upvote 0
How would I go to just get to copy column B,E and F?
Sorry but I have made it a fair bit longer to make it more flexible which helped with my testing and should make it easier to change.

VBA Code:
Sub ReadDataFromCloseFile()
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
   
    Dim srcWB As Workbook
    Dim srcSht As Worksheet
    Dim thisWB As Workbook
    Dim thisSht  As Worksheet
    Dim iTotalRows As Integer
    Dim iColNo As Integer, i As Integer
    Dim arrColNo As Variant
   
    ' Column numbers to copy
    arrColNo = Array(2, 5, 6)                  ' <--- Numeric Equivalent of B,E,F
   
    Set srcWB = Workbooks.Open("C:\Users\MT\Desktop\MasterFile.xlsx", True, True)
    Set srcSht = srcWB.Worksheets("Sheet1")     ' <--- It is possible that ActiveSheet would work better for you here
    Set thisWB = ThisWorkbook
    Set thisSht = thisWB.Worksheets("Sheet1")
   
    With srcSht
        iTotalRows = .Range("A1:A" & .Cells(Rows.Count, "A").End(xlUp).Row).Rows.Count
    End With
   
    For i = LBound(arrColNo) To UBound(arrColNo)
        iColNo = arrColNo(i)
        thisSht.Cells(1, iColNo).Resize(iTotalRows).Formula = srcSht.Cells(1, iColNo).Resize(iTotalRows).Formula
    Next i
      
    srcWB.Close False
    Set srcWB = Nothing
   
ErrHandler:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
End Sub
 
Upvote 0
@Alex Blakenburg Thanks, this works perfectly, the only down side is that it past the result in Columns B,E and F. I would need to copy the result in Columns A,B and C.
I should have mentioned this :oops:
 
Upvote 0
Give Getobject("C:\Users\MT\Desktop\MasterFile.xlsx") a try.
Instead of workbooks.open

If you only extract data from a closed workbook it's likely to use getobject. Everything happens at the background then.
 
Upvote 0
@Alex Blakenburg Thanks, this works perfectly, the only down side is that it past the result in Columns B,E and F. I would need to copy the result in Columns A,B and C.
I should have mentioned this :oops:
That is fine, just replace this
VBA Code:
    For i = LBound(arrColNo) To UBound(arrColNo)
        iColNo = arrColNo(i)
        thisSht.Cells(1, iColNo).Resize(iTotalRows).Formula = srcSht.Cells(1, iColNo).Resize(iTotalRows).Formula
    Next i

with this
VBA Code:
    Dim iOutCol As Integer
    iOutCol = 0
  
    For i = LBound(arrColNo) To UBound(arrColNo)
        iColNo = arrColNo(i)
        iOutCol = iOutCol + 1
        thisSht.Cells(1, iOutCol).Resize(iTotalRows).Formula = srcSht.Cells(1, iColNo).Resize(iTotalRows).Formula
    Next i

I am concerned about you bringing in formulas though, even more so if you are going to position the columns in a different spot.
Are you sure you don't want to just bring in the Values ie change the ".Formula" to ".Value" (or .Value2) as in:-
VBA Code:
        thisSht.Cells(1, iOutCol).Resize(iTotalRows).Value = srcSht.Cells(1, iColNo).Resize(iTotalRows).Value
 
Upvote 0
@Alex Blakenburg
Sorry for late reply, Christmas break from work world!!

Thanks again this is getting better and better!!

I was trying to apply from @JEC and replaced the line:
Set srcWB = Workbooks.Open("C:\Users\MT\Desktop\MasterFile.xlsx", True, True)

with

Set srcWB = Getobject("C:\Users\MT\Desktop\MasterFile.xlsx")

To avoid opening the workbook in the background but nothing is happening
 
Upvote 0
You don't see anything happen because it is in the background ;)

When you run this from the vba Editor, do you suddenly see a new VBA project appearing at the left?
 
Upvote 0

Forum statistics

Threads
1,213,504
Messages
6,114,016
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top