tkaplan
12-01-2005, 07:55 AM
I have a folder with about 300 workbooks in them, each workbook having one sheet.
The format of the name of each of the workbooks it <<text>>XXXX.xls with the XXXX being four numbers.
I want to open up each of these files, take the one sheet and copy it to one workbook, with the tab name being XXXX.
I wrote the following macro:
Sub CopySheets()
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
With ActiveWorkbook
MyPath = .Path & "\wkbks"
End With
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
Else
MsgBox Len(FNames) & " files found"
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(Right(mybook.Name, 8), 4)
' ActiveSheet.Name = Left(ActiveSheet.Name, Len(ActiveSheet.Name) - 4)
On Error GoTo 0
mybook.Close False
FNames = Dir()
Loop
ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub
This macro works when I test it out on 25 books.
the line "MsgBox Len(FNames) & " files found"" only recognizes up to 25 books.
How can I do this without the 25 book limit??
The format of the name of each of the workbooks it <<text>>XXXX.xls with the XXXX being four numbers.
I want to open up each of these files, take the one sheet and copy it to one workbook, with the tab name being XXXX.
I wrote the following macro:
Sub CopySheets()
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
With ActiveWorkbook
MyPath = .Path & "\wkbks"
End With
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
Else
MsgBox Len(FNames) & " files found"
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(Right(mybook.Name, 8), 4)
' ActiveSheet.Name = Left(ActiveSheet.Name, Len(ActiveSheet.Name) - 4)
On Error GoTo 0
mybook.Close False
FNames = Dir()
Loop
ActiveWorkbook.Save
Application.ScreenUpdating = True
End Sub
This macro works when I test it out on 25 books.
the line "MsgBox Len(FNames) & " files found"" only recognizes up to 25 books.
How can I do this without the 25 book limit??