Macro Save workbook to current month folder in path

[hajiali]

Sub CopyActiveSheet()Dim ws As Worksheet
Dim wb As Workbook
Dim Pth As String
Pth = ActiveWorkbook.Path & "\"
Set ws = ActiveSheet
ws.Copy
With ActiveWorkbook
ws.Cells.Copy .Sheets(1).Range("A1")
    ActiveWorkbook.SaveAs Filename:= _
        "[COLOR=#ff0000]K:\Work\Admin\Schedule\September\14.xlsx"[/COLOR], FileFormat _
        :=xlOpenXMLWorkbook, CreateBackup:=False
End With
ActiveWorkbook.Close False
End Sub

I have the Folders for each month in path "K:\Work\Admin\Schedule" what I'm trying to accomplish is that for it to automatically select the current month folder in that path and save the file as sheet name. As shown above I put the Month path and sheet name 14.

any help is greatly appreciated

 

[Fluff]

How about

"K:\Work\Admin\Schedule\" & format(date,"mmmm") & "\" & activesheet.name & ".xlsx"

 

[hajiali]

Thanks Fluff. Is there a way to change the above code to copy selected Sheet instead of activeSheet without having to specify the sheet name in code.

 

[Fluff]

Not sure what you mean, there will only be one sheet in the new workbook, therefore it will be the active sheet.

 

[hajiali]

not in the new workbook. The current workbook has 10 sheets and the above code copies the activesheet to new workbook. Instead of active sheet I want to be able to Select few sheets and copy them to new workbook. so If i Select sheet 14, 15, 16 ,17 i what to us the above code to copy those to new workbook. without specify the sheet name to copy in the code so avoid using Sheets(Array("14", "15", "16", "17")).Copy.

 

[Fluff]

You can use

ActiveWindow.SelectedSheets.Copy

To copy all the selected sheets to a new workbook.

 

[hajiali]

Sub CopyActiveSheet()Dim ws As WorksheetDim wb As Workbook
Dim Pth As String
Pth = ActiveWorkbook.Path & ""
Set ws = ActiveSheet
ws.Copy
With ActiveWorkbook
ws.Cells.Copy .Sheets(1).Range("A1")
ActiveWorkbook.SaveAs Filename:= _
"K:\Work\Admin\Schedule" & format(date,"mmmm") & "" & activesheet.name & ".xlsx", FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
End With
ActiveWorkbook.Close False End Sub

Where would I place that and Would I need to remove whats in Red

 

[Fluff]

Like

Sub CopyActiveSheet()

Dim ws As Worksheet
Dim wb As Workbook
Dim Pth As String
Pth = ActiveWorkbook.Path & ""
ActiveWindow.SelectedSheets.Copy
With ActiveWorkbook
ActiveWorkbook.SaveAs Filename:= _
"K:\Work\Admin\Schedule" & Format(Date, "mmmm") & "" & ActiveSheet.Name & ".xlsx", FileFormat _
:=xlOpenXMLWorkbook, CreateBackup:=False
End With
ActiveWorkbook.Close False
End Sub