Call CreateFolders Sub CreateFolders() Set oFSO = CreateObject("Scripting.FileSystemObject") Set folder = oFSO.GetFolder("\\diskstation\wzory\2019") Set subfolders = folder.subfolders FoldersCount = subfolders.Count Start = FoldersCount + 1 Finish = FoldersCount + 10 for i = Start to Finish 'Create a new folder 'MsgBox i oFSO.CreateFolder "\\192.168.100.100\wzory\2019\" & i & "-19" 'i = i + 1 next MsgBox "Gotowe" end Sub