open workbooks to extract info into one

[Saz]

HI
o.k. I think I may have been abit ambitious when I started out thi
morning as this is my 3rd thread to day and it is 6pm here in the uk.

Right I want to be able to open workbooks through the combining of th
name of one cell with .xls (working along a row).

Through opening each workbook I want it to extract data from cells c
to c39 into the corresponding column found in the final workbook.

Therefore if the final workbook is called summary and in D4 it state
the name BOB. I want it to open BOB.xls and retrieve data from cells c
to c39 into (summary workbook) cells d6 to d39.

However I want it to move along the 4th row until there are no mor
names and stop.

I told you I was being ambitious!
Here was my starter for ten

Private Sub CommandButton1_Click()
Dim j As Integer, x As Integer, z As Integer
x = 4
For j = 6 To 39
If Cells(5, x).Value <> ".xls" Then
Workbooks.Open (x)
If Workbooks(x).Worksheets("Sheet1").Cells(j, 5).Value = z Then
z = Cells(j, x)
x = x + 1
j = j + 1
End If
End If
Next j
End Sub

I am wishing like I want England to win the world cup, I know - pleas
can you help!

Thank

 

[Guest]

Assume the first name is in cell A4. As written, it assumes names don't have
".xls" on the end (my code addes it - you can remove that part).

Assumes all the files are in the directory specified by sPath.

Data is copied from the first sheet in each workbook.


Private Sub CommandButton1_Click()
Dim rng as Range, cell as Range
Dim sPath as String
Dim bk as Workbook
sPath = "C:\MyFolder"
With Workbooks("Summary").Worksheets("Sheet1")
set rng = .Range(.Range("A4"),.Range("IV4").End(xltoLeft))
End With

for each cell in rng
set bk = Workbooks.Open(sPath & "\" & cell.Value & ".xls")
set rng = bk.Worksheets(1).Range("C6:C39")
rng.copy cell.Offset(2,0)
bk.close Savechanges:=False
Next
End Sub