Option Explicit
Public Sub ImportWorkbook()
Dim sWorkbookName As String
Dim wbImport As Workbook
Dim wsImport As Worksheet
Dim sMessage As String
[COLOR=#008000] ' ask user for new filename every time this routine runs
[/COLOR] sWorkbookName = Application.GetOpenFilename(FileFilter:="Excel files (*.xl*), *.xl*", MultiSelect:=False)
[COLOR=#008000] ' if they press Escape or click Cancel, exit routine now
[/COLOR] If sWorkbookName = "False" Then Exit Sub
[COLOR=#008000] ' open imported workbook - but disable workbook_open macro from running first!
[/COLOR] Application.EnableEvents = False
Set wbImport = Workbooks.Open(sWorkbookName, , True)
Application.EnableEvents = True
[COLOR=#008000] ' cycle round each worksheet, import it and save its new name
[/COLOR] For Each wsImport In wbImport.Sheets
wsImport.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
sMessage = sMessage & vbTab & ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name & vbCrLf
Next wsImport
[COLOR=#008000] ' close imported workbook
[/COLOR] wbImport.Close SaveChanges:=False
MsgBox sWorkbookName & " imported. New worksheets are:-" & vbCrLf & Space(20) & vbCrLf _
& sMessage & vbCrLf, vbOKOnly + vbInformation
End Sub