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
--------------------------------------------------------------------------------------------------------
No comments:
Post a Comment
Hi User, Thank You for visiting My Blog. Please post your genuine Feedback or comments only related to this Blog Posts. Please do not post any Spam comments or Advertising kind of comments which will be Ignored.