1
  • Problem:

I am working on the "Extract" workbook and expect to copy some data from the "Sales2021" workbook which is closed. The point is: when I have 2 workbooks open, the code works perfectly but when I close "Sales2021", it runs into error. My purpose is to modify the script so that even when "Sales2021" is closed, it still works.

  • Code explanations:

"Extract" contains 2 sheets, sheet1 and sheet2 (sheet2 is the destination sheet where I want to copy data from "Sales2021" to). "Sales2021" has only "Master_data" sheet. I want to check whether cells (1,2) and (1,3) of sheet1 match data in column 2 and 3 of "Master_data".

Sub Extract()
   Dim LastRow As Long
   Dim i As Long, j As Long

   'Find the last used row in Column A
   With Workbooks("Sales2021.xlsm").Sheets("Master_data")
      LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
   End With

   'Copy headers
   Worksheets("Extract").Rows(1).Value = Workbooks("Sales2021.xlsm").Sheets("Master_data").Rows(1).Value
   
   'first row number'
   With Worksheets("Sheet2")
      j = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
   End With

   For i = 1 To LastRow
       With Workbooks("Sales2021.xlsm").Sheets("Master_data")
           If (.Cells(i, 2).Value = Worksheets("Sheet1").Cells(1, 1).Value And .Cells(i, 3).Value = Worksheets("Sheet1").Cells(1, 2).Value) Or (.Cells(i, 2).Value = Worksheets("Sheet1").Cells(1, 1).Value And Worksheets("Sheet1").Cells(1, 2).Value = "") Then
               .Rows(i).Copy Destination:=Worksheets("Sheet2").Range("A" & j)
               j = j + 1
           End If
       End With
   Next i
End Sub
Laura
  • 35
  • 5
  • 1
    The only way I know to read from a closed Workbook is via ADO. However, you could check if the workbook is closed and if yes, open it without displaying, do your data extraction and close it immediately. – FunThomas Oct 03 '22 at 06:39
  • `ExecuteExcel4Macro` can be used to retrieve individual cell values but it is unrealistic to use it to iterate over cells. [ExecuteExcel4Macro to get value from closed workbook](https://stackoverflow.com/questions/9259862/executeexcel4macro-to-get-value-from-closed-workbook) . ADO would be the best option, if the information is setup in a list. – TinMan Oct 03 '22 at 06:55
  • How could I change the codes with ADO? – Laura Oct 03 '22 at 06:58
  • Quick question. Why not open the workbook via code.. run your rest of the code and then close it again? – Siddharth Rout Oct 03 '22 at 07:40
  • 1
    Also instead of looping through the rows and then copying them, I would rather use the [Autofilter method](https://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s) to copy all the relevant data in one go! – Siddharth Rout Oct 03 '22 at 07:50

1 Answers1

0

I haven't really tested this. The code checks if the workbooks is already open and opens it if needed.

Public Sub Extract()

    Const EXPECTED_PATH As String = "C:\Users\Laura\Test\Sales2021.xlsm.xlsx"
    
    'Check if the file is already open, if it isn't then open it.
    Dim ReportBk As Workbook
    Dim wrkBk As Workbook
    For Each wrkBk In Application.Workbooks
        If wrkBk.FullName = EXPECTED_PATH Then
            Set ReportBk = wrkBk
            Exit For
        End If
    Next wrkBk
    If wrkBk Is Nothing Then
        Set ReportBk = Workbooks.Open(EXPECTED_PATH)
    End If
    
    Dim Source_LastRow As Long
    With ReportBk.Worksheets("Master_data")
        Source_LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        ThisWorkbook.Worksheets("Extract").Rows(1).Value = .Rows(1).Value
    End With
    
    Dim Target_LastRow As Long
    With ThisWorkbook.Worksheets("Sheet2")
        Target_LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
    End With
    
    With ReportBk.Worksheets("Master_data")
        Dim i As Long
        For i = 1 To Source_LastRow
           If (.Cells(i, 2).Value = Worksheets("Sheet1").Cells(1, 1).Value And _
                    .Cells(i, 3).Value = Worksheets("Sheet1").Cells(1, 2).Value) Or _
                    (.Cells(i, 2).Value = Worksheets("Sheet1").Cells(1, 1).Value And _
                    Worksheets("Sheet1").Cells(1, 2).Value = "") Then
                
                .Rows(i).Copy Destination:=Worksheets("Sheet2").Cells(Target_LastRow, 1)
                Target_LastRow = Target_LastRow + 1
           End If
        Next i
    End With
    
End Sub
Darren Bartrup-Cook
  • 18,362
  • 1
  • 23
  • 45