Macro to create new folder, new excel file and copy data into this file.

[nikx1]

Dear Experts,

I have an excel file having four columns. Column A has first name, column B has last name, column C has client id and column D has concatenated values of column a,b and c. This is long list of over 100 clients.

I need a macro to create a folder named as per value in column d in location “D:\Client”. Further create an excel file named “Client Info” in this folder having the values in column a,b and c in “Sheet 1” of the excel file in cell a1, b1 and c1. This needs to continue for each client till the end of the client list.

Sincerely request you to help.

Thanks and Regards,

Nikx

 

[JLGWhiz]

Try this.

Sub makeDir()
Dim sh As Worksheet, wb As Workbook, lr As Long, rng As Range, c As Range, fPath As String
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("A1:A" & lr)
    For Each c In rng
        fPath = "D:\Client\" & c.Offset(0, 3).Value
        MkDir fPath
        Set wb = Workbooks.Add
        wb.SaveAs fPath & "\Client Info.xlsx"
        c.Resize(1, 3).Copy wb.Sheets(1).Range("A1")
        wb.Close
    Next
End Sub

 

[nikx1]

Dear JLGWhiz,

Thanks a lot for your quick help!! The macro works exactly as per my requirement. However, it asks if I need to save the changes done before saving each excel file. I have saved all the files but would be requiring to use this macro often. Could you please help me in auto saving the excel files?

Thanks and Regards,

Nikx

 

[JLGWhiz]

Dear JLGWhiz,

Thanks a lot for your quick help!! The macro works exactly as per my requirement. However, it asks if I need to save the changes done before saving each excel file. I have saved all the files but would be requiring to use this macro often. Could you please help me in auto saving the excel files?

Thanks and Regards,

Nikx

I think that if we reorganize the sequence of events it will cure the alert message issue.

Sub makeDir()
Dim sh As Worksheet, wb As Workbook, lr As Long, rng As Range, c As Range, fPath As String
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("A1:A" & lr)
    For Each c In rng
        fPath = "D:\Client\" & c.Offset(0, 3).Value
        MkDir fPath
        Set wb = Workbooks.Add
        c.Resize(1, 3).Copy wb.Sheets(1).Range("A1")
        wb.SaveAs fPath & "\Client Info.xlsx"
        wb.Close
    Next
End Sub

Regards, JLG

 

[nikx1]

Dear JLG,

The code works perfect!!! My sincere thanks for your kind help. You saved a lot of time and effort...

Thanks and Regards,

Nikx

 

[JLGWhiz]

Dear JLG,

The code works perfect!!! My sincere thanks for your kind help. You saved a lot of time and effort...

Thanks and Regards,

Nikx

You're welcome,
Regards, JLG