Creating a vba code so the file save in month folders

[excelnoob298]

Hi guys

Im having trouble with the final part of this vba code so i was hoping this community could help. im trying to create a vba that will save the file in month folders. Now my file save in year folder but i want it to to save in a month in that year folder. example. if i save the file today i want it to go to 2020 folder and find the mai month folder and save it there. if i do it next month then the same thing just in  june folder. 

Range("F3").Value = ""

Windows("Import OT.xlsm").Activate
Sheets("Cash").Select
Dim filename101 As String
Dim path101 As String
Application.DisplayAlerts = False
path101 = "C:\Users\Username\Dropbox\A271\5 Oppgjør\2020\"
filename101 = Range("B1").Value & ".xlsx"
ActiveWorkbook.SaveAs path101 & Range("A1") & " " & filename101, xlOpenXMLWorkbook
Application.DisplayAlerts = True

end sub

Range B1 is company name And A1 is month 

Now my file save in 2020 folder with the right name everything fine to this part. but the last trouble part is i want it to go to month in that year so i dont have to drag the files always to its month. 

Thanks

[#2]

@excelnoob298 

You may try something like this...

Dim filename101 As String
Dim path101 As String
Dim fso As Object

Application.DisplayAlerts = False

Set fso = CreateObject("Scripting.FileSystemObject")


path101 = Environ("UserProfile") & "\Dropbox\A271\5 Oppgjør\" & Year(Date) & "\"

If Not fso.FolderExists(path101) Then
    MsgBox "The folder " & path101 & " doesn't exist.", vbExclamation
    Exit Sub
End If

filename101 = Range("B1").Value & ".xlsx"

ActiveWorkbook.SaveAs path101 & Range("A1").Value & "\" & filename101, xlOpenXMLWorkbook
Application.DisplayAlerts = True

[#3]

@Subodh_Tiwari_sktneer thanks for the code but its seems like the code dont want to run. its stops at Activeworkbook.saveas and dont run anymore. 

1. I do have folder already created so the code for folder creating i dont think i need it. but it just stops working when the code comes to saving it dont do it. 
2. Could please explain if that environ is something i have to copy to or remove it and why is the username in brackets?  im new to this so im trying to learn.

3. Can you see if there is anything i can add on the code i wrote instead of writing all new? If its not possible to add anything then its no problem i can just go with that code. 

Thanks

[#4]

@excelnoob298 

The Environ function is used to replace the bold part "C:\Users\Username\Dropbox\A271\5 Oppgjør\2020\" in the folder location.

What error msg do you get? The default error description would give you an idea about why the code gets failed. If the error msg has a file location in it, make sure the file location reported in the error msg exists.

Though the fso filesystemobject checks in the beginning if the path101 is a valid folder location and exists. So if the code execution passes that line it means the issue is with the month name entered in the A1.

Insert a breakpoint at the line which saves the active workbook and just before this line place the line given below, so that the code will stop at the breakpoint and  debug.print will print the full path of the file being saved in the Immediate Window. See if it looks good in there, if not, tweak it accordingly.

Debug.Print path101 & Range("A1").Value & "\" & filename101

[#5]

@Subodh_Tiwari_sktneer I found where the problem was and was able to fix it. Thanks for the help. i had one more question if you could here there too. the code i run now is the code i sent above. now the only problem is that how i learned from internet was to write it for every sheet and that will be to much code to write if i have 200 sheets to work on. 
Do you know how to make the code i sent above to run through every sheet in that workbook? and also the same with this. both work togheter now but the problem is i have 200-300 sheets to work on every month so to write this same code so many times in vba with different path names makes it difficult. 

This is the whole code; 

ActiveSheet.Next.Select
If Range("F3").Value = "" Then
Windows("Import OT.xlsm").Activate
Sheets("Cash").Select
Dim filename101 As String
Dim path101 As String
Application.DisplayAlerts = False
path101 = "C:\Users\Username\Dropbox\A271\5 Oppgjør\2020\"
filename101 = Range("B1").Value & ".xlsx"
ActiveWorkbook.SaveAs path101 & Range("A2") & "\" & Range("A1") & " " & filename101, xlOpenXMLWorkbook
Application.DisplayAlerts = True
Else
Cells.Select
Range("F3").Activate
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Dim Path1 As String
Dim Path2 As String
Dim oppgjør1 As String
Dim fpathname1 As String
Path1 = "C:\Users\Username\Dropbox\A271\4 Lønnslipper\"
Path2 = Range("F3")
oppgjør1 = Range("B3")
fpathname1 = Path1 & Path2 & "\" & Range("F2") & " " & oppgjør1 & ".xlsx"
ActiveWorkbook.SaveAs filename:=fpathname1, FileFormat:=51
ActiveWorkbook.Close

The problem lays in that for it to run on every sheet i have to write this code 200 times with every path name different so it dont stop. If you could help me simplify it if possible or make a code which runs through every sheet in the workbook.

thanks