Macro to copy selected cells from all the .xls files in a folder

[rakeshplb]

Hi All,

I have a folder "D:\Documents and Settings\Rakesh", which has many .xls files. Each file has a sheet called 'Cover Note'. I want to copy cells B2, C2, D4 and F3 from 'Cover Note' of each file.

These cells should be pasted in the current sheet, one row for each file. First cell of each row should have the source file name.

It would be better if macro can prompt to select the directory where ther source files resides.

Please, can anybody help me. Thanks.

Rakesh

 

[rakeshplb]

Can anyone help me? this is very urgent.

Thanks all for your help.

 

[westconn1]

Sub test()
Dim wb As Workbook
Dim sht As Worksheet
Dim r As Integer
Set sht = ActiveSheet 'sheet for results
r = 2 '1st row
myDir = "D:\Documents and Settings\Rakesh\BS Recs\Feb 09\"
myfile = Dir(myDir & "*.xls")
Do While Len(myfile) > 0
Set wb = Workbooks.Open(myDir & myfile)
fnd = false
for each ws in wb.sheets
    if ws.name = "Cover Note" then fnd = true : exit for
next
if fnd then
With wb.Sheets("Cover Note")
sht.Cells(r, 1) = wb.Name
sht.Cells(r, 2) = .Range("B2")
sht.Cells(r, 3) = .Range("b2")
sht.Cells(r, 4) = .Range("D2")
sht.Cells(r, 5) = .Range("d5")
End With
else
msgbox "no cover note in " & wb.name
end if
wb.Close
myfile = Dir
r = r + 1
Loop
End Sub

 

[rakeshplb]

Thanks Buddy!