Thread: Create new workbooks named after each cell in column A

I have a bunch of company names and blank cells in column A. I wish to create a new workbook for each company name.

Hi Xx7,

Use the following code:-

Sub WkBk()
o = ActiveWorkbook.Name
Cells(1, 1).Select
k = Range("a65536").End(xlUp).Row
For n = 1 To k
    i = ActiveCell.Value
    If i <> "" Then
        Application.Workbooks.Add
        ActiveWorkbook.SaveAs (i)
        Windows(o).Activate
        ActiveCell.Offset(1, 0).Select
    Else
    ActiveCell.Offset(1, 0).Select
    End If
Next
End Sub

Sample file is also attached. Thanks.

Regards,
DILIPandey

<click on below 'star' if this helps>

that's great. Is there anyway to save them to a folder instead of opening them?

Thanks!

you are welcome Xx7,

Change the below line in code:-

ActiveWorkbook.SaveAs (i)

to

ActiveWorkbook.SaveAs ("C:\Users\DILIPandey\Downloads\" & i)

Where path is "C:\Users\DILIPandey\Downloads\" and you need to just change this path to your choice.

Regards,
DILIPandey

<click on below 'star' if this helps>