Save Processed Files Into Different Another Folder
I have following code: i Want to save the processed files into different folders.but in my code it is saving all files in one folder.How can i make the changes in my code to refelect all processed files in differnet folders
.
=========================
Code:
Sub rrr()
'
' rrr Macro
'
' Keyboard Shortcut: Ctrl+r
'
'
' rrr Macro
'
' Keyboard Shortcut: Ctrl+r
'
'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\"
Dim strCurrentFile As String
Dim sDateFind As String
Dim sDateRep As String
Dim rLastCell As Range
Dim LR As Long
strCurrentFile = Dir(strFolderPath & "*.csv")
Application.ScreenUpdating = False
Do
With Workbooks.Open(strFolderPath & strCurrentFile)
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
Workbooks.SaveAs FileName:= _
"P:\D2\macros\new act\"
.Close True
Workbooks.SaveAs FileName:= _
"P:\D2\macros\new act\"
End With
strCurrentFile = Dir
Loop While Len(strCurrentFile) > 0
Application.ScreenUpdating = True
MsgBox "Data formatting is completed successfully!!!!"
End Sub
