Hi
I have this macro but it is not saving the 2nd part of the workbook into the folder. Any ideas why not?
I have this macro but it is not saving the 2nd part of the workbook into the folder. Any ideas why not?
VBA Code:
Sub x()
Dim sName As Variant, bFolder As String, dest As String, sh As Worksheet
sName = InputBox("Subfolder name")
If sName = "" Then Exit Sub
bFolder = "\\lo-nas01\ArrivaShared\Passenger Accounts\WA\Old sumaries"
If Dir(bFolder & "\" & sName, vbDirectory) = "" Then
MkDir bFolder & "\" & sName
End If
dest = bFolder & "\" & sName & "\"
ActiveWorkbook.SaveCopyAs dest & "NEW SUMMARY1.xls"
Workbooks.Open dest & "NEW SUMMARY1.xls"
Worksheets.Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
ActiveWorkbook.Close True
ChDir "T:\Passenger Accounts\WA\WA SDT & SUMMARY 201\INPUT SCREENS"
Workbooks.Open Filename:= _
"T:\Passenger Accounts\WA\WA SDT & SUMMARY 201\INPUT SCREENS\WEEK 1.xlsm"
Sheets(Array("Thursday", "Friday ")).Select
ActiveWorkbook.SaveCopyAs dest & "NEW SUMMARY1.xls"