Macro Compiles Sheets to One Book...Small Modification Needed
 

I have been using the following macro to collect all of the first sheet
stored in multiple workbooks. Now, I am trying to change this macro s
that it will collect all of the sheets in each of the workbooks and no
just the first sheet in each book. Any ideas?


Code
-------------------
Sub GetFiles()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "C:\Documents and Settings\desktop\testfolder"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Do While FNames < ""
Set mybook = Workbooks.Open(FNames)
mybook.Worksheets(1).Copy after:= _
basebook.Sheets(basebook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = Left(mybook.Name, Len(mybook.Name) - 4)
On Error GoTo 0

' You can use this if you want to copy only the values
' With ActiveSheet.UsedRange
' .Value = .Value
' End With

mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True

Application.DisplayAlerts = False
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = False




End Su
-------------------

--
TEA
-----------------------------------------------------------------------
TEAM's Profile: http://www.excelforum.com/member.php...fo&userid=2281
View this thread: http://www.excelforum.com/showthread.php?threadid=46791

Macro Compiles Sheets to One Book...Small Modification Needed
 

Hi Team

mybook.Worksheets.Copy after:= _

You can use this but what do you want to do with the sheet names ?

On Error Resume Next
ActiveSheet.Name = Left(mybook.Name, Len(mybook.Name) - 4)
On Error GoTo 0


--
Regards Ron de Bruin
http://www.rondebruin.nl


"TEAM" wrote in message
...

I have been using the following macro to collect all of the first sheets
stored in multiple workbooks. Now, I am trying to change this macro so
that it will collect all of the sheets in each of the workbooks and not
just the first sheet in each book. Any ideas?


Code:
--------------------
Sub GetFiles()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "C:\Documents and Settings\desktop\testfolder"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Do While FNames < ""
Set mybook = Workbooks.Open(FNames)
mybook.Worksheets(1).Copy after:= _
basebook.Sheets(basebook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = Left(mybook.Name, Len(mybook.Name) - 4)
On Error GoTo 0

' You can use this if you want to copy only the values
' With ActiveSheet.UsedRange
' .Value = .Value
' End With

mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True

Application.DisplayAlerts = False
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = False




End Sub
--------------------


--
TEAM
------------------------------------------------------------------------
TEAM's Profile: http://www.excelforum.com/member.php...o&userid=22810
View this thread: http://www.excelforum.com/showthread...hreadid=467916