Open a file and copy/paste the 3rd sheet's data into a workbook using a dynamic path made with cells "B2" "B9" and "B4"

Viewed 60

I am trying to build code that performs the following:

  1. Opens a file path made of a string of text and cells B2, B9, and B4 in my current workbook
  2. Copies the data on the third sheet of the opened file
  3. Pastes the data in a specific sheet of my current workbook
Sub GrabData()

Dim ThisWorkbook As Workbook 'our current workbook
Dim swb As Workbook ' data source workbook we need to open
Dim sws As Worksheet ' data source worksheet we need to open
Dim Path As String ' Path for file we need to open

'Now, I will try to make a dynamic path link.
Path = "U:\1. NAME - 25\1. MONTH \SQL Recon\" & ThisWorkbook.Range("B2") & "\" & ThisWorkbook.Range("B9") & " " & ThisWorkbook.Range("B4") & "\Basic\[Dir.xls]" & ".xls"

Set swb = Workbooks.Open(Path) ' the file we want to open
Set sws = swb.Sheets(3).Range("A1:S300").Copy 'Set the sheet and the range we want to copy in our data source workbook equal to page 3, cells A1 to S300
ThisWorkbook.Worksheets("DATA DUMP").Range("A1").PasteSpecial xlPasteValues 'the sheet I want to drop the data in
swb.Close ' close the data source workbook

End Sub
1 Answers

Change Sheets(1) to the sheet where the file path values are.

Option Explicit

Sub GrabData()

    Dim swb As Workbook ' data source workbook we need to open
    Dim sws As Worksheet ' data source worksheet we need to open
    Dim mypath As String ' Path for file we need to open
    
    With ThisWorkbook
        'Now, I will try to make a dynamic path link.
        With .Sheets(1)
             mypath = "U:\1. NAME - 25\1. MONTH \SQL Recon\" _
             & .Range("B2") & "\" & .Range("B9") & " " & .Range("B4") _
             & "\Basic\[Dir.xls]" & ".xls"
        End With
        
        If Dir(mypath) = "" Then
             MsgBox mypath & " not found", vbCritical
             Exit Sub
        End If
        
        ' the file we want to open
        Set swb = Workbooks.Open(mypath, ReadOnly:=True)
        Set sws = swb.Sheets(3)
        
        ' copy data
        .Sheets("DATA DUMP").Range("A1:S300") = sws.Range("A1:S300")
    End With
    swb.Close savechanges:=False
    MsgBox "Done", vbInformation

End Sub
Related