Sub OpenfileRenameSheetsCopy()
Dim strFile As String
mFolder = "E:\test\"
strFile = Dir(mFolder & "*.xls*")
Set wbmaster = ActiveWorkbook
Do While strFile <> ""
    Set WB = Workbooks.Open(mFolder & strFile)
    exname = Mid(ActiveWorkbook.Name, 5, 3)
    For Each sh In ActiveWorkbook.Sheets
      sh.Name = exname & " - " & sh.Name
      sh.Copy After:=wbmaster.Sheets(1)
    Next
    WB.Close False
    strFile = Dir
Loop
End Sub