![]()
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
Bookmarks