Get values

[Rimdur]

I have about 200 excel files made from a template. I need to get values
from cell F45 in all files into a new excel file. There is only one
spreadsheet in every file that has values.
Is there a way to copy cell F45 from all 200 files into a new excel file,
included the filename for each value??

Jon

 

[Bob Phillips]

Rimdur,

Here's a VBA solution that uses the FileSystemObject. Just change to your
file folder

Sub mGetMyData()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubfolder As Object
Dim objFile As Object
Dim iRow As Long
Dim oDetails As Workbook
Dim oSheet As Worksheet

Application.ScreenUpdating = False
Set oDetails = Workbooks.Add
Set oSheet = oDetails.Worksheets(1)
iRow = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("c:\MyTest\")
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=objFolder.Path & "\" & objFile.Name
oSheet.Cells(iRow, 1).Value = objFolder.Path & "\" &
objFile.Name
oSheet.Cells(iRow, 2).Value =
ActiveWorkbook.Worksheets(1).Range("F45").Value
ActiveWorkbook.Close savechanges:=False
iRow = iRow + 1
End If
Next
Application.ScreenUpdating = True
End Sub

 

[Orlando Magalhães Filho]

Hi RimDur,

If your workbooks aren't file protected you don't need to open them. This
method is so rapid. For example, on code from Bob Philips do this:

Sub mGetMyData()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubfolder As Object
Dim objFile As Object
Dim iRow As Long
Dim oDetails As Workbook
Dim oSheet As Worksheet

Application.ScreenUpdating = False
Set oDetails = Workbooks.Add
Set oSheet = oDetails.Worksheets(1)
iRow = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("c:\MyTest\")
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
oSheet.Cells(iRow, 1).Value = objFolder.Path & "\" & objFile.Name
oSheet.Cells(iRow, 2).Formula = "='" & objFolder.Path & "\[" &
objFile.Name & "]Sheet1'!$F$45"
oSheet.Cells(iRow, 2).Formula = oSheet.Cells(iRow, 2).Value 'Unlink
(Optional)
iRow = iRow + 1
End If
Next
Application.ScreenUpdating = True
End Sub

-
HTH

 

[Rimdur]

Rimdur,

Here's a VBA solution that uses the FileSystemObject. Just change to your
file folder

Sub mGetMyData()
Dim objFSO As Object
Dim objFolder As Object
Dim objSubfolder As Object
Dim objFile As Object
Dim iRow As Long
Dim oDetails As Workbook
Dim oSheet As Worksheet

Application.ScreenUpdating = False
Set oDetails = Workbooks.Add
Set oSheet = oDetails.Worksheets(1)
iRow = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("c:\MyTest\")
For Each objFile In objFolder.Files
If objFile.Type = "Microsoft Excel Worksheet" Then
Workbooks.Open Filename:=objFolder.Path & "\" & objFile.Name
oSheet.Cells(iRow, 1).Value = objFolder.Path & "\" &
objFile.Name
oSheet.Cells(iRow, 2).Value =
ActiveWorkbook.Worksheets(1).Range("F45").Value
ActiveWorkbook.Close savechanges:=False
iRow = iRow + 1
End If
Next
Application.ScreenUpdating = True
End Sub

Thanks for the code... But I can't make it work.
I'm a newbee at this.

I have changed the file folder from c:\mytest to c:\aaaaa\bbbbb
The code "works" and a new excel file is beeing created but its empty.

The worksheet that has data is called befaring. I have Norwegian excel
2000.
My default worksheets when I open a new workbook is called Ark1, Ark2, Ark3.

Any suggestions.
Thanks


Jon

 

[Bob Phillips]

Rimdur,

I am using worksheet index not name so the Norwegian version shouldn't make
any difference (famous last words!).

Why don't you send direct to me a few, say 6, of those files, tell me what
directory you will use, and I will run it up on my machine.

What version of Excel?