Save Processed Files Into Different Another Folder

[DARSHANKmandya]

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
.


=========================

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