Multiple Files

kevinc

New Member
Joined
Apr 15, 2002
Messages
1
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.
 

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
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..
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,526
Messages
6,114,136
Members
448,551
Latest member
Sienna de Souza

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top