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

ghrek

Active Member
Joined
Jul 29, 2005
Messages
298
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?

VBA Code:
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
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
60,320
Office Version
  1. 365
Platform
  1. Windows
Cross posted.

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

ghrek

Active Member
Joined
Jul 29, 2005
Messages
298
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.
 
Last edited:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
60,320
Office Version
  1. 365
Platform
  1. Windows
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.
 

Forum statistics

Threads
1,137,122
Messages
5,679,732
Members
419,854
Latest member
marvin24

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top