Dim folder As String

    folder = "B:\NCC\ntsd\cable\" & Format(Date, "mmmm") & "\"
    On Error Resume Next
    MkDir folder
    On Error GoTo 0
    With ActiveWorkbook
    
        .SaveAs Filename:=folder & .Name
    End With