How do I get a macro to create a folder , ask me to name it and move files to it

[ghrek]

Hi

I have the following macro of which saves files into a folder called "backup" What im trying to then is in the folder I need it to create a subfolder and ask me to name it and then move all the individual files into it.

I will be doing this on a monthly basis so I will need a seperate subfolder for each time the macro run within the folder called backup
Any Ideas?

Sub WEDNESDAY()
'
' WEDNESDAY Macro
'

'
    ActiveWorkbook.SaveAs Filename:= _
        "https://arrivagroup.sharepoint.com/teams/PASSACC2/Shared%20Documents/General/backup/SUMMARY.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Workbooks.Open Filename:= _
        "https://arrivagroup.sharepoint.com/teams/PASSACC2/Shared%20Documents/General/INPUT%20SCREENS/WEEK%201.xlsm"
    ActiveWorkbook.LockServerFile
    ActiveCell.FormulaR1C1 = ""
    ActiveWorkbook.SaveAs Filename:= _
        "https://arrivagroup.sharepoint.com/teams/PASSACC2/Shared%20Documents/General/backup/WEEK%201.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Sheets(Array("Wednesday", "Thursday", "Friday ")).Select
    Sheets("Wednesday").Activate
    Range("J75,B6:AD75").Select
    Range("B75").Activate
    Selection.ClearContents
    Range("AJ6:BM75").Select
    Selection.ClearContents
    ActiveWorkbook.Save
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    ActiveWindow.SmallScroll Down:=24
    Workbooks.Open Filename:= _
        "https://arrivagroup.sharepoint.com/teams/PASSACC2/Shared%20Documents/General/INPUT%20SCREENS/WEEK%202.xlsm"
    ActiveWorkbook.LockServerFile
    Sheets(Array("Tuesday ", "Friday ")).Select
    Sheets("Friday ").Activate
    ActiveWindow.SmallScroll Down:=-75
    ActiveWorkbook.SaveAs Filename:= _
        "https://arrivagroup.sharepoint.com/teams/PASSACC2/Shared%20Documents/General/backup/WEEK%202.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.SmallScroll Down:=-21
    Range("B30,B6:AD76").Select
    Range("B6").Activate
    Selection.ClearContents
    Range("AJ6:BM76").Select
    Range("AJ76").Activate
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=72
    ActiveWindow.ScrollColumn = 60
    ActiveWindow.ScrollColumn = 61
    ActiveWindow.ScrollColumn = 62
    ActiveWindow.ScrollColumn = 63
    ActiveWindow.SmallScroll Down:=-3
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    ActiveWindow.SmallScroll Down:=3
    Sheets("WEEK2").Select
    ActiveWindow.SmallScroll Down:=3
    Workbooks.Open Filename:= _
        "https://arrivagroup.sharepoint.com/teams/PASSACC2/Shared%20Documents/General/INPUT%20SCREENS/WEEK%203.xlsm"
    ActiveWorkbook.LockServerFile
    ActiveWorkbook.SaveAs Filename:= _
        "https://arrivagroup.sharepoint.com/teams/PASSACC2/Shared%20Documents/General/backup/WEEK%203.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Range("K25").Select
    ActiveWorkbook.SaveAs Filename:= _
        "https://arrivagroup.sharepoint.com/teams/PASSACC2/Shared%20Documents/General/backup/WEEK%203.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWorkbook.SaveAs Filename:= _
        "https://arrivagroup.sharepoint.com/teams/PASSACC2/Shared%20Documents/General/backup/WEEK%203.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.SmallScroll Down:=-18
    Sheets(Array("Tuesday ", "Friday ")).Select
    Sheets("Friday ").Activate
    ActiveWindow.SmallScroll Down:=-27
    Range("K25,B6:AD76").Select
    Range("B6").Activate
    Selection.ClearContents
    Range("AJ6:BM76").Select
    Range("AJ76").Activate
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=78
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Range("P57").Select
    Workbooks.Open Filename:= _
        "https://arrivagroup.sharepoint.com/teams/PASSACC2/Shared%20Documents/General/INPUT%20SCREENS/WEEK%204.xlsm"
    ActiveWorkbook.LockServerFile
    ActiveWorkbook.SaveAs Filename:= _
        "https://arrivagroup.sharepoint.com/teams/PASSACC2/Shared%20Documents/General/backup/WEEK%204.xlsx" _
        , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Sheets(Array("Tuesday", "Friday")).Select
    Sheets("Friday").Activate
    ActiveWindow.SmallScroll Down:=-75
    Range("B35,B6:AD76").Select
    Range("B6").Activate
    Selection.ClearContents
    Range("AJ6:BM76").Select
    Range("AJ76").Activate
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=-6
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    Sheets("WEEK1").Select
    ActiveWindow.SmallScroll Down:=-48
    Sheets("PERIODSUMMARY").Select
    ActiveWindow.SmallScroll Down:=3
    Sheets("WEEK1").Select
    Range("C13").Select
    ActiveWindow.SmallScroll Down:=0
    Sheets(Array("WEEK1", "WEEK2", "WEEK3", "WEEK4")).Select
    Sheets("WEEK1").Activate
    Range("C13").Select
    ActiveWindow.SmallScroll Down:=15
    Range("C13,C29:W29").Select
    Range("W29").Activate
    ActiveWindow.SmallScroll Down:=24
    Range("C13,C29:W29,C46:R46").Select
    Range("C46").Activate
    Sheets(Array("WEEK1", "WEEK2", "WEEK3", "WEEK4")).Select
    Sheets("WEEK1").Activate
    Range("K54").Select
    Sheets("PERIODSUMMARY").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 30
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 32
    ActiveWindow.ScrollColumn = 33
    ActiveWindow.ScrollColumn = 34
    ActiveWindow.ScrollColumn = 35
    ActiveWindow.ScrollColumn = 36
    ActiveWindow.ScrollColumn = 37
    ActiveWindow.ScrollColumn = 38
    ActiveWindow.ScrollColumn = 39
    ActiveWindow.ScrollColumn = 40
    ActiveWindow.ScrollColumn = 41
    ActiveWindow.ScrollColumn = 42
    ActiveWindow.ScrollColumn = 43
    ActiveWindow.ScrollColumn = 44
    ActiveWindow.ScrollColumn = 45
    ActiveWindow.ScrollColumn = 46
    ActiveWorkbook.SaveAs Filename:= _
        "https://arrivagroup.sharepoint.com/teams/PASSACC2/Shared%20Documents/General/SUMMARY.xlsm" _
        , FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
End Sub

 

[Fluff]

Cross posted.

You know full well what the rules are relating to cross posting.
Please supply all relevant links.

 

[ghrek]

I accept what you say and apologise. Please close this thread.

I have read on a different website concerning what it means to people and now have a full understanding.

 

[Fluff]

There is no need to close the thread, all we ask is that you supply a link to any other site where you have asked this question.