Create multiple workbooks

[VBABEGINER]

Hi Team,

i have data from col A to L.

in my col B i have names
abc
abc
abc
xyz
xyz
xyz
xyz
xyz

and in col A i have 3 different names for "abc" and 5 different names for "xyz", and go on till last record of col B.

so i wanted to create workbook "abc" and it should contain their data in that sheet.

can any one pls share the code..

----
For more example-
workbook name - Raw "abc" and this book will contain all the row till col L in this workbook
abc
abc
abc

 

[VBABEGINER]

Hi Experts, can i please any suggestion on this..

 

[Logit]

.

Option Explicit


Sub Nits(): Dim r As Long, i As Long, wb As Workbook, EO As String, ws As Worksheet, K
Set ws = ActiveSheet: r = ws.Range("A1").CurrentRegion.Rows.Count
Application.ScreenUpdating = False
                    With CreateObject("Scripting.Dictionary")
                        For i = 2 To r: EO = ws.Cells(i, 2)
                        If Not .Exists(EO) Then .Item(EO) = i
                        Next i: K = .Keys()
                        For i = 0 To UBound(K)
        ws.Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:=K(i)
        
                            Set wb = Workbooks.Add
        ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy wb.Sheets(1).Range("A1")
                wb.SaveAs ws.Parent.Path & "/" & K(i) & i: wb.Close
        
        ws.Range("A1").CurrentRegion.AutoFilter


Next i
End With
Application.ScreenUpdating = True
End Sub

 

[Fluff]

How about

Sub vbabeginer()
   Dim Wbk As Workbook
   Dim Ws As Worksheet
   Dim Cl As Range
   Dim Ky As Variant
   
   Application.ScreenUpdating = False
   Set Ws = Sheets("Pcode")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws.Range("B2", Ws.Range("B" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Empty
      Next Cl
      For Each Ky In .Keys
         Set Wbk = Workbooks.Add
         Ws.Range("A1:L1").AutoFilter 2, Ky
         Ws.AutoFilter.Range.Copy Wbk.Sheets(1).Range("A1")
         Wbk.SaveAs ThisWorkbook.path & "\" & Ky, 52
         Wbk.Close False
      Next Ky
      Ws.AutoFilterMode = False
   End With
End Sub

 

[VBABEGINER]

Hi Logit, Hi Fluff... Excellent!! Brilliant working..

Only some points are missed from end..

- From the workbook which this books are creating, should have same format..
- Name of sheet also needed like name of workbook
and last,
- can these workbook's save as .xlsx format please..

 

[VBABEGINER]

Both the code was super fantastic absolute rocking woooooo...

The only thing is that, i cant understand the code..

 

[Fluff]

How about

Sub vbabeginer()
   Dim Wbk As Workbook
   Dim Ws As Worksheet
   Dim Cl As Range
   Dim Ky As Variant
   
   Application.ScreenUpdating = False
   Set Ws = Sheets("Pcode")
   With CreateObject("scripting.dictionary")
      .CompareMode = 1
      For Each Cl In Ws.Range("B2", Ws.Range("B" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Empty
      Next Cl
      For Each Ky In .Keys
         Ws.Copy
         Set Wbk = ActiveWorkbook
         With ActiveSheet
            .Name = Ky
            .Range("A1:L1").AutoFilter 2, "<>" & Ky
            .AutoFilter.Range.Offset(1).EntireRow.Delete
            .AutoFilterMode = False
         End With
         Wbk.SaveAs ThisWorkbook.path & "\" & Ky & ".xlsx", 51
         Wbk.Close False
      Next Ky
   End With
End Sub

 

[VBABEGINER]

ray:ray: Excellent / Amazing


but, really apologies from my end.. one more i missed.. there is one more sheet named "Sheet1" where i have some values..

C2 = Y
C3 = N

D2 = H
D3 = M
D4 = L

so actually i pick up this value in drop down in column's H I J K..

Rest, Fabulous..

How about

Sub vbabeginer()
   Dim Wbk As Workbook
   Dim Ws As Worksheet
   Dim Cl As Range
   Dim Ky As Variant
   
   Application.ScreenUpdating = False
   Set Ws = Sheets("Pcode")
   With CreateObject("scripting.dictionary")
      .CompareMode = 1
      For Each Cl In Ws.Range("B2", Ws.Range("B" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Empty
      Next Cl
      For Each Ky In .Keys
         Ws.Copy
         Set Wbk = ActiveWorkbook
         With ActiveSheet
            .Name = Ky
            .Range("A1:L1").AutoFilter 2, "<>" & Ky
            .AutoFilter.Range.Offset(1).EntireRow.Delete
            .AutoFilterMode = False
         End With
         Wbk.SaveAs ThisWorkbook.path & "\" & Ky & ".xlsx", 51
         Wbk.Close False
      Next Ky
   End With
End Sub

 

[Fluff]

You're welcome & thanks for the feedback

 

[VBABEGINER]

Hi Fluff Sir,

Pls suggest update code on my post #8