Here is the 'generic' code. Some setup may be required. First - all 600
files must be in the same folder with the file you create with this code in
it. You can always copy them all into a single folder which gives the added
protection of working with copies rather than the originals.
The code assumes your other workbooks don't have leading zeros in their
names for single/double-digit numbered files. That is, that the filenames
are like datas1.xls or datas11.xls and NOT like datas001.xls or datas011.xls
To put this code into use, open/create a new workbook. Press [Alt]+[F11] to
enter the VBA Editor. In the VBA Editor, use its menu to Insert | Module.
Then copy the code below and paste it into the empty code module presented to
you. Save the workbook in the same folder with the other 600 files. Use
Tools | Macro | Macros to [Run] the macro. Have a large cup of coffee while
it runs. Nothing is going to change on the screen while it runs - I set it
up that way for speed. When it's all done, you'll see all the added
worksheets in it. This could take some time, it takes time just to open and
close 600 workbooks, and Excel is probably going to have to "regroup" during
the addition of all those worksheets into this book.
Sub Copy600Sheets()
'all datas# and datag# files must be
'in the same folder with this file
'The sheet you want to copy from each
'of those other 600 workbooks is
'assumed to be the first sheet in
'those workbooks.
'
'This is not going to be fast -
'start the process and go have
'a cup of coffee or tea - your choice.
'
Const sFileNameStart = "datas"
Const gFileNameStart = "datag"
Const fileType = ".xls"
Dim LC As Integer ' loop counter
Dim alienBookName As String
Dim alienBook As Workbook
Dim basePath As String
basePath = Left(ThisWorkbook.FullName, _
InStrRev(ThisWorkbook.FullName, Application.PathSeparator))
'this will make it faster and "quieter", but
'it means you will see no screen activity until
'the whole job is done - enjoy your coffee/tea
Application.ScreenUpdating = False
For LC = 1 To 300
'the naming assumes NO leading zeros for
'workbooks with double-digit names, that is:
'name is like datas29.xls and not like datas029.xls
'same for single-digit names: datas1.xls not datas001.xls
alienBookName = sFileNameStart & Trim(Str(LC)) & fileType
If Dir$(basePath & alienBookName) <> "" Then
'found the datas#.xls file
Application.DisplayAlerts = False
'open w/o updating links, in read only mode
Workbooks.Open basePath & alienBookName, False, True
Set alienBook = Workbooks(alienBookName)
alienBook.Worksheets(1).Copy After:= _
ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
alienBook.Close False ' close, don't save changes
ThisWorkbook.Worksheets(Worksheets.Count).Name = _
sFileNameStart & Trim(Str(LC))
End If
'the naming assumes NO leading zeros for
'workbooks with double-digit names, that is:
'name is like datag29.xls and not like datag029.xls
'same for single-digit names: datag1.xls not datag001.xls
alienBookName = gFileNameStart & Trim(Str(LC)) & fileType
If Dir$(basePath & alienBookName) <> "" Then
'found the datas#.xls file
Application.DisplayAlerts = False
'open w/o updating links, in read only mode
Workbooks.Open basePath & alienBookName, False, True
Set alienBook = Workbooks(alienBookName)
alienBook.Worksheets(1).Copy After:= _
ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
alienBook.Close False ' close, don't save changes
ThisWorkbook.Worksheets(Worksheets.Count).Name = _
gFileNameStart & Trim(Str(LC))
End If
DoEvents ' let the system get some work done also
Next ' end of LC loop
Set alienBook = Nothing
'let's see what we've accomplished
Application.ScreenUpdating = True
End Sub
