Sunday, 30 September 2012

Excel VBA Macro To Create a Folder By Current Date And Time ,Export Active Sheet Data to a New Workbook By Active Sheet Name

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

No comments:

Post a Comment

Follow Me by Email

ExcelKingdom-Popular Posts

ExcelKingdom-Random Posts