L
Len
Hi,
After few attempts, the following codes fails to add new sheets and
rename its sheet to this workbook after copying worksheet from each
excel file under MPV folder
Dim i%, SheetArg$()
Dim sPath As String
Dim sFile As Variant
Dim oSht As Integer
Dim ShtFile As String
Windows("ABC.xls").Activate
sPath = "D:\My Documents\MPV\"
sFile = Dir(sPath & "*.xls", vbNormal)
Workbooks.Open Filename:=sPath & sFile
Do While sFile <> ""
oSht = Worksheets.Count
Workbooks(sFile).Sheets(1).Copy
Before:=Workbooks("ABC.xls").Sheets(oSht)
ShtFile = Left(sFile, InStrRev(sFile, ".") - 3)
ActiveSheet.Name = ShtFile
oSht = oSht + 1
Workbooks(sFile).Close SaveChanges:=False
sFile = Dir()
Loop
Any help will be appreciated and thanks in advance
Regards
Len
After few attempts, the following codes fails to add new sheets and
rename its sheet to this workbook after copying worksheet from each
excel file under MPV folder
Dim i%, SheetArg$()
Dim sPath As String
Dim sFile As Variant
Dim oSht As Integer
Dim ShtFile As String
Windows("ABC.xls").Activate
sPath = "D:\My Documents\MPV\"
sFile = Dir(sPath & "*.xls", vbNormal)
Workbooks.Open Filename:=sPath & sFile
Do While sFile <> ""
oSht = Worksheets.Count
Workbooks(sFile).Sheets(1).Copy
Before:=Workbooks("ABC.xls").Sheets(oSht)
ShtFile = Left(sFile, InStrRev(sFile, ".") - 3)
ActiveSheet.Name = ShtFile
oSht = oSht + 1
Workbooks(sFile).Close SaveChanges:=False
sFile = Dir()
Loop
Any help will be appreciated and thanks in advance
Regards
Len