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

 

[westconn1]

you can try like this

set sht = activesheet    ' sheet for results
r = 1  ' 1st row
mydir = "D:\Documents and Settings\Rakesh\"
myfile = dir(mydir & "*.xls")
do while len(myfile) > 0
   set wb = workbooks.open(mydir & myfile)
   with wb.sheets("cover note")
      sht.cells(r.1) =  wb.name
      sht.cells(r.2) =  .range("b2")
      sht.cells(r.3) =  .range("c2")
      sht.cells(r.4) =  .range("D4")
      sht.cells(r.5) =  .range("F3")
   end with
   wb.close
   myfile = dir
loop

you can call a file dialog or browseforfolder to select the folder or just use an inputbox

 

[rakeshplb]

Thanks westconn1, but can you provide the full sub procedure please!

Waiting for you

 

[westconn1]

well as i don't know how you want to call the code, by button event or some other method, hard to say what sub you want it in
just copy that code into any empty sub and run
you should declare
wb as workbook
sht as worksheet
and r as integer
mydir and myfile as strings

also forgot to increment r in loop
add line after myfile = dir
r = r + 1

 

[rakeshplb]

I tried with this code and getting errors, Could you please correct

Sub test()
Dim wb As Workbook
Dim sht As Worksheet
Dim r As Integer
Set sht = ActiveSheet ' sheet for results
r = 1 ' 1st row
myDir = "D:\Documents and Settings\zz1g2j\Desktop\Macro Testing\"
myfile = Dir(myDir & "*.xls")
Do While Len(myfile) > 0
Set wb = Workbooks.Open(myDir & myfile)
With wb.Sheets("cover note")
sht.cells(r.1) = wb.name
sht.cells(r.2) = .range("b2")
sht.cells(r.3) = .range("c2")
sht.cells(r.4) = .range("D4")
sht.cells(r.5) = .range("F3")
End With
wb.Close
myfile = Dir
Loop
End Sub

 

[ayazgreat]

<TABLE style="WIDTH: 288pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=384 border=0 x:str><COLGROUP><COL style="WIDTH: 48pt" span=6 width=64><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD class=xl64 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 96pt; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-ignore: colspan" width=128 colSpan=2 height=17>Posted again same </TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 48pt; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent" width=64>question?</TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 48pt; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent" width=64></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 48pt; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent" width=64></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; WIDTH: 48pt; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent" width=64></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl64 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl64 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-ignore: colspan" colSpan=4 height=17>Have you not received answer here</TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl64 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" height=17></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD><TD style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; BACKGROUND-COLOR: transparent"></TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD class=xl65 style="BORDER-RIGHT: #d4d0c8; BORDER-TOP: #d4d0c8; BORDER-LEFT: #d4d0c8; BORDER-BOTTOM: #d4d0c8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent; mso-ignore: colspan" colSpan=6 height=17>http://www.mrexcel.com/forum/showthread.php?t=382343</TD></TR></TBODY></TABLE>

 

[rakeshplb]

No, No working solution yet

Please help

 

[westconn1]

what error are you getting?
note you still need to add the line to increment r in the loop

edit looks like i typoed a . instead of a , in the cells address, then copied to all
sht.cells(r , 1) = wb.name
change for each line

also this will only get the file in the first folder, to get the files in sub folders you would need to call dir recursively
or convert to the fso method posted in the other thread that i have now seen, personally i would stick with dir, but many prefer fso

 

[rakeshplb]

when I try to run these lines appear in red -

sht.cells(r.1) = wb.name
sht.cells(r.2) = .range("b2")
sht.cells(r.3) = .range("c2")
sht.cells(r.4) = .range("D4")
sht.cells(r.5) = .range("F3")

Msg box says compile error syntax error

This is the code I have been using - Sub test()+

Dim wb As Workbook
Dim sht As Worksheet
Dim r As Integer
Set sht = ActiveSheet ' sheet for results
r = 1 ' 1st row
myDir = "D:\Documents and Settings\zz1g2j\Desktop\Macro Testing\"
myfile = Dir(myDir & "*.xls")
Do While Len(myfile) > 0
Set wb = Workbooks.Open(myDir & myfile)
With wb.Sheets("cover note")
sht.cells(r.1) = wb.name
sht.cells(r.2) = .range("b2")
sht.cells(r.3) = .range("c2")
sht.cells(r.4) = .range("D4")
sht.cells(r.5) = .range("F3")
End With
wb.Close
myfile = Dir
r = r + 1
Loop
End Sub

 

[rakeshplb]

Thanks westconn1,

this code is working now -
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)
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
wb.Close
myfile = Dir
r = r + 1
Loop
End Sub

Only one problem - if a single file happens to be without the sheet called "Cover Note", the macro stops. Can you please fix this to list such files or if not possible ignore them.

I also want to take care of sub folders please

Thank yo very much you saved hours of hard work