Excel VBA Macro to Create a Folder By Current Date And Time ,Export Active Sheet Data to a New Workbook By Active Sheet Name
'This is a Very User Friendly and Power Full Utility Macro which Exports Data From Active Sheet to a New Work Book
'The New Work Book is Created with Active Sheet Name and It has only one Sheet having Active Sheet Name & Data.
'We can use this Macro To Save Dalily Tasks from 'Regular Task Workbook' to a WorkBook with Current Date & Time\
Sub CrtTaskShtByToday()
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim F As String
Dim B As String
Dim S As String
Dim W As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
X = Day(Date) 'Day Value From Date
Y = Month(Date) 'Month Value From Date
Z = Year(Date) 'Year Value From Date
F = X & "-" & Y & "-" & Z
B = Workbooks("MainTask").ActiveSheet.Name 'B=New Book Name
S = Workbooks("MainTask").ActiveSheet.Name 'S=Sheet Name In New Book
MkDir "D:\" & F 'Make a Desired Folder By Current Date & Time
Workbooks(B).Close 'Closes Exported Data Book If It Opens
Workbooks.Add.SaveAs ("D:\" & F & "\" & B & ".xlsx")
'New Book Open By Active Sheet Name To Export Data
'A New Book In a Folder with Current Date& Time will be created
Workbooks(B).Sheets.Add.Name = S
'A Sheet Name same As Book Name Will Be Created
Workbooks("MainTask").Activate
ActiveWorkbook.ActiveSheet.Cells.Copy Workbooks(B).Sheets(S).Range("a1")
'Copies Data from Active Sheet of Active WorkBook to a Newley Created Book with the same Sheet Name
For Each W In Workbooks(B).Worksheets
If W.Name <> Sheets(S).Name Then
W.Delete
End If ' Deletes Additional Sheets Except Data Sheet in a New Book
Next W
Workbooks(B).Save 'Your New Exported Data Book
Workbooks(B).Close
End Sub
'This is a Very User Friendly and Power Full Utility Macro which Exports Data From Active Sheet to a New Work Book
'The New Work Book is Created with Active Sheet Name and It has only one Sheet having Active Sheet Name & Data.
'We can use this Macro To Save Dalily Tasks from 'Regular Task Workbook' to a WorkBook with Current Date & Time\
Sub CrtTaskShtByToday()
Dim X As Integer
Dim Y As Integer
Dim Z As Integer
Dim F As String
Dim B As String
Dim S As String
Dim W As Worksheet
On Error Resume Next
Application.DisplayAlerts = False
X = Day(Date) 'Day Value From Date
Y = Month(Date) 'Month Value From Date
Z = Year(Date) 'Year Value From Date
F = X & "-" & Y & "-" & Z
B = Workbooks("MainTask").ActiveSheet.Name 'B=New Book Name
S = Workbooks("MainTask").ActiveSheet.Name 'S=Sheet Name In New Book
MkDir "D:\" & F 'Make a Desired Folder By Current Date & Time
Workbooks(B).Close 'Closes Exported Data Book If It Opens
Workbooks.Add.SaveAs ("D:\" & F & "\" & B & ".xlsx")
'New Book Open By Active Sheet Name To Export Data
'A New Book In a Folder with Current Date& Time will be created
Workbooks(B).Sheets.Add.Name = S
'A Sheet Name same As Book Name Will Be Created
Workbooks("MainTask").Activate
ActiveWorkbook.ActiveSheet.Cells.Copy Workbooks(B).Sheets(S).Range("a1")
'Copies Data from Active Sheet of Active WorkBook to a Newley Created Book with the same Sheet Name
For Each W In Workbooks(B).Worksheets
If W.Name <> Sheets(S).Name Then
W.Delete
End If ' Deletes Additional Sheets Except Data Sheet in a New Book
Next W
Workbooks(B).Save 'Your New Exported Data Book
Workbooks(B).Close
End Sub
--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------