Create new workbook for each item in the list

Balajibenz

Board Regular
Joined
Nov 18, 2020
Messages
80
Office Version
  1. 2013
Platform
  1. Windows
Hi Can someone help with below requirement with VBA code.

I have got two sheets sheet1 and sheet2. sheet1 got data in A-X and sheet2 got a list in column B as below.

Manager
Max
Harry
Murat
Vamsi
Adam

what i am looking for is code that loop through the above list and for each name it has to filter the name sheet1 data in column "X" and then copy the filtered (A-X including headers) data and paste (should be in same format as source) it in new workbook and save the workbook in the same path as the currentworkbook. sheet name in new new workbook should also be the manager name.
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
See if this is what you want.

VBA Code:
Sub t()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, wb As Workbook
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
    For Each c In sh2.Range("B2", sh2.Cells(Rows.Count, 2).End(xlUp))
        sh1.UsedRange.AutoFilter 24, c.Value
            If sh1.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
                Set wb = Workbooks.Add
                sh1.UsedRange.SpecialCells(xlCellTypeVisible).Copy
                wb.Sheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
                wb.Sheets(1).Range("A1").PasteSpecial xlPasteFormats
                wb.SaveAs ThisWorkbook.Path & "\" & c.Value & ",xlsx"
                wb.Close False
                sh1.AutoFilterMode = False
            End If
    Next
End Sub
 
Upvote 0
Solution
Try:
VBA Code:
Sub CreateWorkbooks()
    Application.ScreenUpdating = False
    Dim srcWB As Workbook, manager As Range
    Set srcWB = ThisWorkbook
    For Each manager In Sheets("Sheet2").Range("B2", Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp))
        With Sheets("Sheet1")
            .Range("A1").CurrentRegion.AutoFilter 24, manager
            .AutoFilter.Range Copy
            Workbooks.Add
            ActiveSheet.Name = manager
            Range("A1").PasteSpecial
            With ActiveWorkbook
                .SaveAs srcWB.Path & Application.PathSeparator & manager & ".xlsx"
                .Close False
            End With
        End With
    Next manager
    Sheets("Sheet1").Range("A1").AutoFilter
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Correct the typo in this line
VBA Code:
wb.SaveAs ThisWorkbook.Path & "\" & c.Value & ".xlsx"
 
Upvote 0
Hi all,

For a simplified variation on this theme, I was hoping to simply create new workbooks named after a list of names in column A, and save them to a drive and close them. For some reason I cannot get it to work, no matter the variation on your code.

The length of the list will be variable (between 1 and 20 files) and I'd like to save it in directory "C:\Users\Steve\Desktop\PA Test Folder\Test Files\OneDrive Files\"

1657068983930.png


Could you please help? I'm going crazy!
Thanks
Steve
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,949
Members
448,534
Latest member
benefuexx

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top