Copy from a closed excel file

[mtagliaferri]

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.

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

 

[Alex Blakenburg]

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.

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

 

[mtagliaferri]

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.

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!

 

[mtagliaferri]

How would I go to just get to copy column B,E and F?

 

[Alex Blakenburg]

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.

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

 

[mtagliaferri]

@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

 

[JEC]

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.

 

[Alex Blakenburg]

@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

That is fine, just replace this

    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

    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:-

        thisSht.Cells(1, iOutCol).Resize(iTotalRows).Value = srcSht.Cells(1, iColNo).Resize(iTotalRows).Value

 

[mtagliaferri]

@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

 

[JEC]

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?