Extract Range multiple external Workbooks

[Partjob]

I would like to grab data from external work books. I then want to consolidate a range in each workbook on to the original workbook. There are lots of examples of this type of code on here but I am struggling adapting it to my needs All the target workbooks are the same name. ("Spend review tracker ECC.xls") I have this in Cell C3 the file path changes though. The first part is fixed (K:\940 Spend Reviews\38 - Project Spend Review\) I have this in cell A1. The next part is variable, I have this listed in Cells A3:A36. There is then another bit of the file path that is fixed (\Constr\) I have this in Cell B2.

So my file path would be A1&Variable&B2&C3

I have no idea how to build that file path to use it.

Once I have the file path I want to go to the file, extract data in Sheet "Application" Range (I60:T60) without actually opening the file perferably and paste the values in to the original sheet in column D the row being the same row that the variable part of the file path is in.

Now for the more difficult part I think. Not all the paths will be valid at the time the code runs but would be at some time in the future. I believe this means I need an exit sub if the file path is not valid and move to the next file path, again no idea.

The thing is although I have begun to write my own code snippets, I struggle starting off. I generally understand what is going on once it is written.

Thanks a lot
Partjob

 

[Partjob]

Ok I have been at this all day and have come up with this

Sub GetData()
Dim FPa As String
Dim JobNo As Range
Dim FPb As String
Dim TRow As Integer
Dim Fnm As String
Dim MyWbk As String
MyWbk = ThisWorkbook.Name
TRow = 3
FPa = Sheet1.Cells(1, 1).Text
FPb = Sheet1.Cells(1, 2).Text
For Each JobNo In Range("A3:A36")
Fnm = FPa & JobNo & FPb
Workbooks.Open Filename:=Fnm
With ActiveWorkbook
Sheets("Application").Range("I60:S60").Copy
Workbooks(MyWbk).Sheets("Sheet1").Cells(TRow, 4).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        End With
        TRow = TRow + 1
        ActiveWorkbook.Close SaveChanges:=False
        Next JobNo
End Sub

It nearly does what I need. I can not work out how to make the code move to the next JobNo when there is an error with the filepath. I also need the code to add 1 to the TRow variable when it forced to the next JobNo when there is an error.
As I said in my earlier post I really would have liked this to get the data without opening the files, I don't know how though.

I really would appreciate some help with this Thank you
Partjob

 

[Partjob]

Not really sure why I am not getting any help on this one could somebody or anybody please give it go.

thanks a million
Partjob

 

[jindon]

try

Sub test()
Dim r As Range, myDir As String, fn As String
fn = Range("C3").Value
For Each r In Range("A3:A36")
    myDir = Range("A1").Value & r.Value & Range("B2").Value
    With r.Offset(,3).Resize(,12)
        .Formula = "='" & myDir & "[" & fn & "]Application'!i60"
        .Value = .Value
    End With
Next
End Sub

 

[Partjob]

Thanks jindon
It took me a few minutes to work out what was going on here. I can not test it fully as I at home and don't have access to the drives from here.
This is how I understand it please can you confirm I am correct. You are building a file path with the fixed cell values and the variables. then building a formula linking the the the target cells to the original sheet. This is all with out opening the target file. Then at the end you change this result to just the value. which I think is clever in its simplicity.
I have tested as far as I can and believe I will have one problem and that is if the file path does not exist. which is possible.
Looking at what happens when this is the case the user get a diolog box to specify the path.

Can I avoid this and if the path is not valid just move to the next path/row

Thanks Partjob

 

[jindon]

Sub test()
Dim r As Range, myDir As String, fn As String
fn = Range("C3").Value
For Each r In Range("A3:A36")
    myDir = Range("A1").Value & r.Value & Range("B2").Value
    If Dir(myDir & fn) <> "" Then
        With r.Offset(,3).Resize(,12)
            .Formula = "='" & myDir & "[" & fn & "]Application'!i60"
            .Value = .Value
        End With
    Else
        r.Offset(,3).Value = "No such file"
    End If
Next
End Sub

 

[Partjob]

jindon you are a gem as I said earlier I can't fully test this till Monday but that looks like it will do the trick. Thanks for the help.

Partjob

 

[jindon]

OK,
Just post back if you find any bug.

 

[Partjob]

Hi
Iam nearly there on this one but I still have a small problem. jindon helped me at the weekend but I was unable to test properly till this morning.
this code is picking up the figures where the file exists, without opening the file.

However I still have aproblem when the path or file does not exist. If I run the code as it is, the code just puts "No such file" regardless whether the path is good or not. When I comment out the red bold lines I have to specify the path.

I just need it to ignor the fact the path doesn't exist and move on I can not get the "If Dir(myDir) = "" Then" correct.

Sub test()
Dim r As Range, myDir As String, FNa As String, FNb As String
FNa = Range("A1").Value
FNb = Range("B1").Value
For Each r In Range("A3:A36")
    myDir = FNa & r.Value & FNb
    [B][COLOR=red]If Dir(myDir) <> "" Then
[/COLOR][/B]        With r.Offset(, 3).Resize(, 12)
            .Formula = "='" & myDir & "Application'!I60"
            .Value = .Value
        End With
    [B][COLOR=red]Else
        r.Offset(, 3).Value = "No such file"
    End If
[/COLOR][/B]Next
End Sub

Thanks a lot
Partjob

 

[jindon]

Can you show me what are exactly in cells in A3:A36, C3 & B2 ?