Multiple Files

[kevinc]

I use EXCEL 97. I have approxiamately 50 files on my desk top. I would like to transfer sheet 1 on all 50 files to a new workbook, 50 sheets deep. Is this possible with out openeing each file individually and Move/Copy Sheet to new book individually?

Thanks in advance for any help you can provide.

[brettvba]

you would probably have to write some code to do this probably the easist would be to open the workbook then record a macro doing the proceedure you want then just run the macro on each workbook

or you could get excel to open up each workbook but that would take just as long to write the code depending on the workbook names..

[Tom Schreiner]

Hi
I would place all of the xls files which contain the sheets to be transfered in a new folder. Create a new workbook in this same folder. Paste this code into a standard module, in the new workbook, and run it.
If any of the workbooks in this folder do not have a "Sheet1" then an error will be generated.

Sub CallingAllSheets()
Dim FS, i
Dim PlaceRow As Long
Dim OpenedName As String
Dim DoNotReopenActiveWB_Name As String
Dim RecievingWb As String

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
DoNotReopenActiveWB_Name = ActiveWorkbook.Path & "" & ActiveWorkbook.Name
RecievingWb = ActiveWorkbook.Name
PlaceRow = 1
Set FS = Application.FileSearch
With FS
.LookIn = ActiveWorkbook.Path
.Filename = "*.xls"
If .Execute Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) <> DoNotReopenActiveWB_Name Then
Workbooks.Open .FoundFiles(i)
OpenedName = ActiveWorkbook.Name
Workbooks(OpenedName).Sheets("Sheet1"). _
Copy Before:=Workbooks(RecievingWb).Sheets(1)
Workbooks(OpenedName).Close savechanges:=False
End If
Next i
End If
End With
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub


Tom

[BabyTiger]

Hi,

You may want to try the following:

Sub CopySheets()
Const DeskTopDir = "c:winntprofilesall usersdesktop"
Dim iFileName As String
Dim iWorkBook As String
iWorkBook = ThisWorkbook.Name
iFileName = Dir(DeskTopDir)
Do While iFileName <> ""
If LCase(Right(iFileName, 4)) = ".xls" Then
Workbooks.Open (DeskTopDir & iFileName)
Sheets("sheet1").Name = Left(iFileName, Len(iFileName) - 4)
Sheets(Left(iFileName, Len(iFileName) - 4)).Copy _
After:=Workbooks(iWorkBook).Sheets(Workbooks(iWorkBook).Sheets.Count)
Workbooks(iFileName).Close (False)
End If
iFileName = Dir
Loop
End Sub

For the desktop directory, you might have to change it to whatever desktop directory on yours, eg. windows 98 would be something like : c:windowsdesktop, etc.

And if the name of the sheet you wanted to copy is not called "sheet1", then you also have to change that. Alternatively, if you want to copy the first of the workbook, instead of using 'sheets("sheet1")', change it to 'sheets(1)'.

HTH

[swaink]

HI Tom

I've read this with interest because I have a similar requirement, however when I step through the code if the original workbook is found it still try's to open it.

Any Ideas

Kev

[Dsuperc]

I have a similar problem.The only difference is the files are on the internet.