Try This:
Code:Sub rrr() 'Change to the correct folder path, be sure to include the ending \ Const strFolderPath As String = "V:\RESG\GTS\STP-OSM\SOC\DashBoard\SandBox - confidential\Data Source - practice\darshan practice\sec alert\antivirus\March\raw data\New Folder\" Const strSaveFolder As String = "P:\D2\macros\new act\" Dim strCurrentFile As String Dim sDateFind As String Dim sDateRep As String Dim rLastCell As Range Dim LR As Long Dim wbkAct As Workbook Dim strCreateFolder As String strCurrentFile = Dir(strFolderPath & "*.csv") Application.ScreenUpdating = False Do Workbooks.Open (strFolderPath & strCurrentFile) Set wbkAct = ActiveWorkbook With wbkAct Columns("E:E").Select Selection.NumberFormat = "dd/mm/yy;@" Columns("L:L").Select Selection.NumberFormat = "dd/mm/yy;@" LR = Cells(Rows.Count, "L").End(xlUp).Row Range("L1:L" & LR) = Evaluate("IF(L1:L" & LR & "=0+""1/1/9999"",E1:E" & LR & _ ",IF(LEN(L1:L" & LR & "),L1:L" & LR & ",""""))") Columns("J:J").Select Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove Columns("I:I").Select Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True strCreateFolder = strSaveFolder & ActiveWorkbook.Name MkDir strCreateFolder .SaveAs Filename:=strCreateFolder & "\" & ActiveWorkbook.Name .Close True End With strCurrentFile = Dir Loop While Len(strCurrentFile) > 0 Application.ScreenUpdating = True MsgBox "Data formatting is completed successfully!!!!" End Sub




Reply With Quote
Bookmarks