I have data in sheets Car.xls; Boat.xls; Rv.xls; Loco.xls
On the first sheet of each of these workbooks, I need to bring in the data
cells a2, a3, b5, b6, b7

And paste it into a summary.xls file.
Starting at Row 6; (a6,b6,c6,d6,e6)
then moving down 1 row for each xls above.

In addition to that, I would like in Column F of each row a hyperlink
created to link back to the source data (Car, Boat, Rv, Loc)

Any and all help is appreciated.

i have code that will do what you want, but don't know enough about using an
array to get the filename. i usually just list the file names in a separate
sheet and access them that way. i'm sure someone will come up witha better
way.

i just listed the names in a1:a4 on sheet2. change the referece to your
needs


Sub import()
Curbook = Application.ThisWorkbook.Name
Dim i As Long, firstrow As Long
lastfile = Worksheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Row
i = 1
firstrow = 6
fname = Worksheets("sheet2").Cells(i, "A").Value
For i = 1 To lastfile
Workbooks.Open Filename:="car.xls", _
ReadOnly:=True, UpdateLinks:=3
With Workbooks(fname).Worksheets("sheet1")

.Range("a2").Copy
Workbooks(Curbook).Worksheets("sheet1").Range("A" &
firstrow).PasteSpecial xlValues
.Range("a3").Copy
Workbooks(Curbook).Worksheets("sheet1").Range("B" &
firstrow).PasteSpecial xlValues
.Range("b5").Copy
Workbooks(Curbook).Worksheets("sheet1").Range("c" &
firstrow).PasteSpecial xlValues
.Range("b6").Copy
Workbooks(Curbook).Worksheets("sheet1").Range("d" &
firstrow).PasteSpecial xlValues
.Range("b7").Copy
Workbooks(Curbook).Worksheets("sheet1").Range("e" &
firstrow).PasteSpecial xlValues
firstrow = firstrow + 1


End With
Workbooks(fname).Close SaveChanges:=False
Next i
End Sub

--


Gary


"Judy" wrote in message
...
I have data in sheets Car.xls; Boat.xls; Rv.xls; Loco.xls
On the first sheet of each of these workbooks, I need to bring in the data
cells a2, a3, b5, b6, b7

And paste it into a summary.xls file.
Starting at Row 6; (a6,b6,c6,d6,e6)
then moving down 1 row for each xls above.

In addition to that, I would like in Column F of each row a hyperlink
created to link back to the source data (Car, Boat, Rv, Loc)

Any and all help is appreciated.

Assumed is that the worksheet in Summary.xls is named "Summary" and that
Summary.xls is in the same folder as the others. Change to suit. Note that
this macro doesn't have to open any workbooks or copy and paste and so should
be slicker. Hyperlinks appear to work. I never use them so have no real
experience.

Written in a hurry with minimal testing:

Sub ImportData()
Dim ws As Worksheet
Dim r1 As Range, r2 As Range, c As Range
Dim P As String
Dim wbarr As Variant
Dim i As Integer, ii As Integer

wbarr = Array("Car.xls", "Boat.xls", "Rv.xls", "Loco.xls")
wbarr = Array("Combinations.xls", "Combinations.xls", "Combinations.xls",
"Combinations.xls")
P = ThisWorkbook.Path 'If not correct change to path of above files
Set ws = Sheets("Summary") 'Assumed wks name in "Summary.xls"
Set r1 = ws.Range("A6:E6")
Set r2 = ws.Range("A2:A3, B5:B7") 'Used to get address only

For i = LBound(wbarr) To UBound(wbarr)
ii = 0
For Each c In r2
ii = ii + 1
r1(i + 1, ii).Formula = "= '" & P & _
"\[" & wbarr(i) & "]Sheet1'!" & c.Address
Next c
r1(i + 1, 6).Hyperlinks.Add r1(i + 1, 6), wbarr(i)
Next i

Set r1 = r1.Resize(ii, 5)
r1.Value = r1.Value
End Sub

Regards,
Greg


"Judy" wrote:

I have data in sheets Car.xls; Boat.xls; Rv.xls; Loco.xls
On the first sheet of each of these workbooks, I need to bring in the data
cells a2, a3, b5, b6, b7

And paste it into a summary.xls file.
Starting at Row 6; (a6,b6,c6,d6,e6)
then moving down 1 row for each xls above.

In addition to that, I would like in Column F of each row a hyperlink
created to link back to the source data (Car, Boat, Rv, Loc)

Any and all help is appreciated.

Oops...

Remove:
wbarr = Array("Combinations.xls", "Combinations.xls", "Combinations.xls",
"Combinations.xls")

I used that for testing purposes. I told you I wrote it in a hurry.

Regards,
Greg

"Greg Wilson" wrote:

Assumed is that the worksheet in Summary.xls is named "Summary" and that
Summary.xls is in the same folder as the others. Change to suit. Note that
this macro doesn't have to open any workbooks or copy and paste and so should
be slicker. Hyperlinks appear to work. I never use them so have no real
experience.

Written in a hurry with minimal testing:

Sub ImportData()
Dim ws As Worksheet
Dim r1 As Range, r2 As Range, c As Range
Dim P As String
Dim wbarr As Variant
Dim i As Integer, ii As Integer

wbarr = Array("Car.xls", "Boat.xls", "Rv.xls", "Loco.xls")
wbarr = Array("Combinations.xls", "Combinations.xls", "Combinations.xls",
"Combinations.xls")
P = ThisWorkbook.Path 'If not correct change to path of above files
Set ws = Sheets("Summary") 'Assumed wks name in "Summary.xls"
Set r1 = ws.Range("A6:E6")
Set r2 = ws.Range("A2:A3, B5:B7") 'Used to get address only

For i = LBound(wbarr) To UBound(wbarr)
ii = 0
For Each c In r2
ii = ii + 1
r1(i + 1, ii).Formula = "= '" & P & _
"\[" & wbarr(i) & "]Sheet1'!" & c.Address
Next c
r1(i + 1, 6).Hyperlinks.Add r1(i + 1, 6), wbarr(i)
Next i

Set r1 = r1.Resize(ii, 5)
r1.Value = r1.Value
End Sub

Regards,
Greg


"Judy" wrote:

I have data in sheets Car.xls; Boat.xls; Rv.xls; Loco.xls
On the first sheet of each of these workbooks, I need to bring in the data
cells a2, a3, b5, b6, b7

And paste it into a summary.xls file.
Starting at Row 6; (a6,b6,c6,d6,e6)
then moving down 1 row for each xls above.

In addition to that, I would like in Column F of each row a hyperlink
created to link back to the source data (Car, Boat, Rv, Loc)

Any and all help is appreciated.

Hi Greg,

This is great - is there a way to get the array to recognize all files in
the directory rather than have to list out each one?

Krista

"Greg Wilson" wrote:

Oops...

Remove:
wbarr = Array("Combinations.xls", "Combinations.xls", "Combinations.xls",
"Combinations.xls")

I used that for testing purposes. I told you I wrote it in a hurry.

Regards,
Greg

"Greg Wilson" wrote:

Assumed is that the worksheet in Summary.xls is named "Summary" and that
Summary.xls is in the same folder as the others. Change to suit. Note that
this macro doesn't have to open any workbooks or copy and paste and so should
be slicker. Hyperlinks appear to work. I never use them so have no real
experience.

Written in a hurry with minimal testing:

Sub ImportData()
Dim ws As Worksheet
Dim r1 As Range, r2 As Range, c As Range
Dim P As String
Dim wbarr As Variant
Dim i As Integer, ii As Integer

wbarr = Array("Car.xls", "Boat.xls", "Rv.xls", "Loco.xls")
wbarr = Array("Combinations.xls", "Combinations.xls", "Combinations.xls",
"Combinations.xls")
P = ThisWorkbook.Path 'If not correct change to path of above files
Set ws = Sheets("Summary") 'Assumed wks name in "Summary.xls"
Set r1 = ws.Range("A6:E6")
Set r2 = ws.Range("A2:A3, B5:B7") 'Used to get address only

For i = LBound(wbarr) To UBound(wbarr)
ii = 0
For Each c In r2
ii = ii + 1
r1(i + 1, ii).Formula = "= '" & P & _
"\[" & wbarr(i) & "]Sheet1'!" & c.Address
Next c
r1(i + 1, 6).Hyperlinks.Add r1(i + 1, 6), wbarr(i)
Next i

Set r1 = r1.Resize(ii, 5)
r1.Value = r1.Value
End Sub

Regards,
Greg


"Judy" wrote:

I have data in sheets Car.xls; Boat.xls; Rv.xls; Loco.xls
On the first sheet of each of these workbooks, I need to bring in the data
cells a2, a3, b5, b6, b7

And paste it into a summary.xls file.
Starting at Row 6; (a6,b6,c6,d6,e6)
then moving down 1 row for each xls above.

In addition to that, I would like in Column F of each row a hyperlink
created to link back to the source data (Car, Boat, Rv, Loc)

Any and all help is appreciated.

I assumed you'd want to select the files rather than automatically import
from all .xls files in the directory. Of course, use the <Shift key to
facilitate selection of multiple files.

If speed is an problem, the macro can be rewritten to populate an array and
then batch dump into the summary sheet. Minimal testing.

Sub ImportData()
Dim ws As Worksheet
Dim r1 As Range, r2 As Range, c As Range
Dim P As String
Dim wbarr As Variant
Dim i As Integer, ii As Integer

With Application
.ScreenUpdating = False
wbarr = .GetOpenFilename("Excel files (*.xls), *.xls", _
MultiSelect:=True)
End With
If VarType(wbarr) = vbBoolean Then Exit Sub
P = wbarr(1)
i = InStrRev(P, "\")
P = Left(wbarr(1), i - 1)
Set ws = Sheets("Summary") 'Assumed wks name in "Summary.xls"
Set r1 = ws.Range("A6:E6")
Set r2 = ws.Range("A2:A3, B5:B7") 'Used to get address only

For i = LBound(wbarr) To UBound(wbarr)
ii = 0
For Each c In r2
ii = ii + 1
r1(i, ii).Formula = "='" & P & _
"\[" & Dir(wbarr(i)) & "]Sheet1'!" & c.Address
Next c
r1(i, 6).Hyperlinks.Add r1(i, 6), wbarr(i)
Next i
Set r1 = r1.Resize(ii, 5)
r1.Value = r1.Value
Application.ScreenUpdating = True
End Sub

Regards,
Greg

"Krista F" wrote:

Hi Greg,

This is great - is there a way to get the array to recognize all files in
the directory rather than have to list out each one?

Krista

"Greg Wilson" wrote:

Oops...

Remove:
wbarr = Array("Combinations.xls", "Combinations.xls", "Combinations.xls",
"Combinations.xls")

I used that for testing purposes. I told you I wrote it in a hurry.

Regards,
Greg

"Greg Wilson" wrote:

Assumed is that the worksheet in Summary.xls is named "Summary" and that
Summary.xls is in the same folder as the others. Change to suit. Note that
this macro doesn't have to open any workbooks or copy and paste and so should
be slicker. Hyperlinks appear to work. I never use them so have no real
experience.

Written in a hurry with minimal testing:

Sub ImportData()
Dim ws As Worksheet
Dim r1 As Range, r2 As Range, c As Range
Dim P As String
Dim wbarr As Variant
Dim i As Integer, ii As Integer

wbarr = Array("Car.xls", "Boat.xls", "Rv.xls", "Loco.xls")
wbarr = Array("Combinations.xls", "Combinations.xls", "Combinations.xls",
"Combinations.xls")
P = ThisWorkbook.Path 'If not correct change to path of above files
Set ws = Sheets("Summary") 'Assumed wks name in "Summary.xls"
Set r1 = ws.Range("A6:E6")
Set r2 = ws.Range("A2:A3, B5:B7") 'Used to get address only

For i = LBound(wbarr) To UBound(wbarr)
ii = 0
For Each c In r2
ii = ii + 1
r1(i + 1, ii).Formula = "= '" & P & _
"\[" & wbarr(i) & "]Sheet1'!" & c.Address
Next c
r1(i + 1, 6).Hyperlinks.Add r1(i + 1, 6), wbarr(i)
Next i

Set r1 = r1.Resize(ii, 5)
r1.Value = r1.Value
End Sub

Regards,
Greg


"Judy" wrote:

I have data in sheets Car.xls; Boat.xls; Rv.xls; Loco.xls
On the first sheet of each of these workbooks, I need to bring in the data
cells a2, a3, b5, b6, b7

And paste it into a summary.xls file.
Starting at Row 6; (a6,b6,c6,d6,e6)
then moving down 1 row for each xls above.

In addition to that, I would like in Column F of each row a hyperlink
created to link back to the source data (Car, Boat, Rv, Loc)

Any and all help is appreciated.