opening worksheets

P

platinum_eye200

I wish to open all the worksheets in a particular folder. Then i wan
to be able to extract information from each worksheet, and it
filename, without entering a filename. Is this possible? How do I d
it?

the reason I want to is quite simple. I have hundreds of worksheet
with inconsistant names, and I want to apply a macro to each, and sav
time by having the macro open, extract, and close the lot.

thanks for your help,

marti
 
T

Tom Ogilvy

Dim sPath as String
Dim sName as String
Dim wkbk as Workbook
sPath = "C:\MyFolder\"
sName = dir(sPath & "*.xls")
do while sName <> ""
set wkbk = Workbooks(sName)
msgbox wkbk.Name
' process the file
wkbk.Close SaveChanges:=False ' or True
sName = Dir()
Loop
 
B

BrianB

Here is code to open all workbooks in a folder. You will need to chang
the code in the transfer_data sub() to do what you want to the opene
book.

Code
-------------------

'==============================================
'- Generic code for processing all
'- workbooks contained in a folder.
'- workbooks must be the only ones in the folder.
'- Change "Sub Transfer_data()" etc. as required.
'------------------------------------------------
'- in this example to summarise tables in all
'- worksheets in all workbooks :-
'- worksheets must be contain tables which are
'- identical to the master, headings in row 1.
'- master sheet is remade each time.
'- run this code from the master book
'- by BrianB January 1st.2004
'----------------------------------------------
Dim ToBook As String
Dim ToSheet As Worksheet
Dim NumColumns As Integer
Dim ToRow As Long
Dim FromBook As String
Dim FromSheet As Worksheet
Dim FromRow As Long
Dim LastRow As Long
'-
'----------------
Sub NEW_MASTER()
'----------------
Application.Calculation = xlCalculationManual
ChDrive ActiveWorkbook.Path
ChDir ActiveWorkbook.Path
ToBook = ActiveWorkbook.Name
'---------------------------
'- MASTER SHEET
'---------------------------
Set ToSheet = ActiveWorkbook.Worksheets(1)
NumColumns = ToSheet.Range("A1").End(xlToRight).Column
ToRow = ToSheet.Range("A65536").End(xlUp).Row
'- clear master
If ToRow <> 1 Then
ToSheet.Range(Cells(2, 1), Cells(ToRow, NumColumns)).ClearContents
End If
ToRow = 2
'------------------------------
'- main loop to open each file
'------------------------------
FromBook = Dir("*.xls")
While FromBook <> ""
If FromBook <> ToBook Then
Application.StatusBar = FromBook
Transfer_data
End If
FromBook = Dir
Wend
'-- close
MsgBox ("Done.")
Application.StatusBar = False
Application.Calculation = xlCalculationAutomatic
End Sub
'---------------------------------------------------------------
'- CHANGE THIS CODE TO DO WHAT YOU WANT TO THE OPENED WORKBOOK
'----------------------------------------------------------------
Sub Transfer_data()
Workbooks.Open FileName:=FromBook
For Each FromSheet In Workbooks(FromBook).Worksheets
LastRow = FromSheet.Range("A65536").End(xlUp).Row
'------------------------------
'- copy paste to master sheet
FromSheet.Range(Cells(2, 1), Cells(LastRow, NumColumns)).Copy _
Destination:=ToSheet.Range("A" & ToRow)
'------------------------------
'- set next ToRow
ToRow = ToSheet.Range("A65536").End(xlUp).Row + 1
Next
Workbooks(FromBook).Close savechanges:=False
End Sub
'==== EOP ======================================
 
Top