Solved: Copy fixed 3 cells from multiple files with 1 or 2 or 3 sheets

[jigar1276]

Hi Experts,

I have a folder containing many excel files with same format. I have written the code for opening each file and copying 3 cells (B3, E3 and E13) from each sheet of each file and paste it to "CheckPIdata.xls".

The code written is:
[vba]
Sub CopyPIDATA()
'
'
Dim fso As Object, folder, filelist, file
Dim ws As Worksheet, wb As Workbook
Set fso = CreateObject("Scripting.filesystemobject")
Set folder = fso.getfolder("C:\Documents and Settings\baraijig\Desktop\pi")
Set filelist = folder.Files
i = 1
For Each file In filelist
Set wb = Workbooks.Open(folder & "\" & file.Name)
For Each ws In wb.Worksheets
i = i + 1
Workbooks("checkPIdata").Worksheets("Sheet1").Range("A" & i).Value = ws.Range("B3").Value
Workbooks("checkPIdata").Worksheets("Sheet1").Range("B" & i).Value = ws.Range("E3").Value
Workbooks("checkPIdata").Worksheets("Sheet1").Range("C" & i).Value = ws.Range("E13").Value
Workbooks(file.Name).Close
Next ws
Set ws = Nothing
Set file = Nothing
Next file
End Sub
[/vba]

The above code works fine. It is opening each file in the folder and copying data to "CheckPIdata.xls". The problem is that the data is copied only from first sheet of each file and not all the sheets of each files.

Filenames and sheetnames are not fixed.

Please help me to rectify my code so that it copies the data from each sheet instead of only one sheet.

Thanks in advance.

[stanleydgrom]

jigar1276,

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Try changing the following lines of code:

[VBA]

Workbooks("checkPIdata").Worksheets(ws).Range("A" & i).Value = ws.Range("B3").Value
Workbooks("checkPIdata").Worksheets(ws).Range("B" & i).Value = ws.Range("E3").Value
Workbooks("checkPIdata").Worksheets(ws).Range("C" & i).Value = ws.Range("E13").Value

[/VBA]


Have a great day,
Stan

[rbrhodes]

Hi jigar1276,

Your problem is that you're closing the WB in the loop before it reads all sheets. Here's my version...

[vba]
'Always a good idea
Option Explicit
Sub CopyPIDATA()
Dim i As Long
Dim fso As Object, folder, filelist, file
Dim ws As Worksheet, wb As Workbook
Set fso = CreateObject("Scripting.filesystemobject")
Set folder = fso.getfolder("C:\temp")
Set filelist = folder.Files

i = 1

For Each file In filelist
Set wb = Workbooks.Open(folder & "\" & file.Name)
For Each ws In wb.Worksheets
i = i + 1
'//Simplify by using 'With'
With Workbooks("checkPIdata.xls").Worksheets("Sheet1")
.Range("A" & i).Value = ws.Range("B3").Value
.Range("B" & i).Value = ws.Range("E3").Value
.Range("C" & i).Value = ws.Range("E13").Value
End With
'//NOT HERE!! Workbooks(file.Name).Close
Next ws

'//Moved out of ws loop so ALL sheets
' are done before wb is closed.
' This is the actual problem!!
Workbooks(file.Name).Close
Next file

'//Cleanup when done
Set wb = Nothing
Set ws = Nothing
Set fso = Nothing
Set file = Nothing
Set folder = Nothing
Set filelist = Nothing

End Sub
[/vba]

[jigar1276]

Thanks rbrhodes, Its working fine now.

[mdmackillop]

Check out this method as well

[jigar1276]

Thanks MD for upgrading my knowledge.