Hi


Sub ProcessAll()
    
    Dim Wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim strPath As String, strPath1 As String, sFile As String
    Dim fName As String, lName As String, loc As String, num As String
    Dim mail As String, id As String, city As String, code As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Set wb3 = ActiveWorkbook
    strPath = "D:\Documents and Settings\u180819\My Documents\VBA codes\New Folder"
    strPath1 = "D:\Documents and Settings\u180819\My Documents\VBA codes\New Folder\New Folder"
    sFile = Dir(strPath & "\" & "*.xlsx")
     'Loop through all .xls-Files in that path
    Do While sFile <> ""
         
        Set Wb1 = Workbooks.Open(strPath & "\" & sFile)
         Wb1.Activate
         'Do something with that Workbook, insert whatever you want to do here
    Wb1.Sheets("Sheet1").Activate
    fName = ActiveSheet.Range("B1").Value
    lName = ActiveSheet.Range("B2").Value
    loc = ActiveSheet.Range("B3").Value
    num = ActiveSheet.Range("B5").Value
    mail = ActiveSheet.Range("B7").Value
    id = ActiveSheet.Range("B8").Value
    city = ActiveSheet.Range("B11").Value
    code = ActiveSheet.Range("B12").Value
    
    Workbooks.Add
    Set wb2 = ActiveWorkbook
    wb3.Activate
    Sheets("Sheet1").Range("A1:D12").Select
    Selection.Copy
    wb2.Activate
    Sheets("Sheet1").Range("A1").Select
    ActiveSheet.PasteSpecial
    ActiveSheet.Range("B1") = id
    ActiveSheet.Range("D1") = fName
    ActiveSheet.Range("B4") = mail
    ActiveSheet.Range("D4") = num
    ActiveSheet.Range("B6") = loc
    ActiveSheet.Range("D6") = lName
    ActiveSheet.Range("B10") = city
    ActiveSheet.Range("B11") = code
    With wb2
        .SaveAs strPath1 & "\" & fName
        .Close
    End With
    Wb1.Activate
         
         
        Debug.Print Wb1.Name
         'You can save it, if you like, here it's not saved
        Wb1.Close False
         
        sFile = Dir
    Loop
End Sub

Regards
Piyush