Try the code below.  Change the FOLDER name as required.  Make sure you
have a backslash at the end of the folder name.  The Macro will give you
an error if the data in cell A1 is not a valid name for a worksheet.
worksheet names can't be nothing and can't contain certain characters.

Sub copybooks()

Folder = "C:\temp\"
FName = Dir(Folder & "*.xls")
Do While FName <> ""
'open workbook
Set bk = Workbooks.Open(Folder & FName)
For Each sht In bk.Worksheets
With ThisWorkbook
sht.Copy after:=.Sheets(.Sheets.Count)
ActiveSheet.Name = sht.Range("A1")
End With
Next sht

bl.Close savechanges:=False
FName = Dir()
Loop

End Sub

--
joel
------------------------------------------------------------------------
joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=152271

Set NewWkb = ThisWorkbook
MyPath = "C:\Documents and Settings\vb\"
ChDir MyPath
TheFile = Dir("*.xls")
Do While TheFile <> ""
Set wb = Workbooks.Open(MyPath & "\" & TheFile)
Set obj = wb.Sheets(1)
obj.Cells.Copy
NewWkb.Sheets.Add before:=NewWkb.Sheets(NewWkb.Sheets.Count)
sht.Copy after:=.Sheets(.Sheets.Count)
With NewWkb.ActiveSheet
.Range("a1").PasteSpecial xlPasteValues
.Name = obj.Range("a1").Value
End With
obj.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = obj.Range("A1")
wb.Close
TheFile = Dir
Application.CutCopyMode = False