Split One tab into Multiple Files with Specific Names

[Jsubby3]

Hello All,

I have been searching up and down trying to plagiarize various code to get this to work. I have a file that lists a series of data for all suppliers, weekly I would like to be able to split these into individual files by supplier and automatically name them as the Supplier name. An example of my data is below, header starts in cell A5 and goes to R5 - obviously would need the headers to be in each individual file. Any help would be greatly, greatly appreciated

Purch. Organization	Plant	Vendor	Name	Purchasing Document	Item	Purchasing Doc. Type	Purchasing Group	Material	Material Description	Schedule Line	Scheduled Quantity	PO UOM	Received Qty Purch UOM	Open Qty Purch UOM	Delivery Date	Stat.-Rel. Del. Date	Delivery Completed
1000	1000	214	Supplier A	64741	20	NB	001	part 1		2	1.000	M2	0.000	1.000	9/30/2017	9/30/2017
1000	1000	432	Supplier B	123	20	NB	001	part 2		1	1.000	M2	0.000	1	9/30/2017	9/30/2017

<tbody>
</tbody>

 

[Fluff]

@RobertSF
The code I've supplied, uses what's called Late Binding & therefore does not require the OP to add any references.

 

[RobertSF]

Cool. Good to know.

 

[Jsubby3]

Fluff - getting further

can advance until

.Range("A5").AutoFilter field:=4, Criteria1:=Ky
.Range("A6:R" & UsdRws).SpecialCells(xlVisible).Copy Range("A1")
Wbk.SaveAs "C:\Users\DaveC\Desktop\test" & Ky, 51
Wbk.Close
Next Ky
.AutoFilterMode = False
End With


End Sub


it launches a new workbook but then I get an application-defined or object-defined error

any thoughts?

 

[Fluff]

I was definitely having a bad day yesterday.
Made a change to the code in post#8 & then realised I had missed some stuff, so reposted as post#9 without one of the previous changes!
The dictionary should be looking from D6 downwards not D2 as per

        For Each Cl In .Range("D[COLOR=#ff0000]6[/COLOR]:D" & UsdRws)
            If Not Dict.exists(Cl.Value) Then Dict.Add Cl.Value, Nothing
        Next Cl

 

[Jsubby3]

ok made the change, it created two new files and named it per the supplier's name... all good. however there is no data and in my original file it took data from rown 7 (headers start in row 6) and put it in Row 1...

1000	1000	432	Supplier B	123	20	NB	001
Purch. Organization	Plant	Vendor	Name	Purchasing Document	Item	Purchasing Doc. Type	Purchasing Group
1000	1000	214	Supplier A	64741	20	NB	001
1000	1000	432	Supplier B	123	20	NB	001

<colgroup><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

 

[Fluff]

however there is no data and in my original file it took data from rown 7 (headers start in row 6) and put it in Row 1...

Don't quite understand this.

Firstly. What row contains the headers? Here you say row 6 earlier you said A5.
Secondly. Are you saying nothing was copied, or are you saying that the header wasn't copied but the rest of the data was?

 

[Jsubby3]

Sorry if I cause any confusion

Header row is 5 - need headers to carry over to each individual file
Data starts in row 6

The macro created two files - Supplier A and Supplier B as intended but the sheets are blank, no header info or data

 

[Fluff]

Give this a go. It will copy the header across, but not sure why the data wasn't getting copied.

Sub FltrCopy()

    Dim Dict As Object
    Dim Ky As Variant
    Dim Cl As Range
    Dim UsdRws As Long
    Dim Wbk As Workbook

Application.ScreenUpdating = False
    Set Dict = CreateObject("scripting.dictionary")

    With Sheets("Data List")
        UsdRws = .Range("D" & Rows.Count).End(xlUp).Row
    
        For Each Cl In .Range("D6:D" & UsdRws)
            If Not Dict.exists(Cl.Value) Then Dict.Add Cl.Value, Nothing
        Next Cl
    
        For Each Ky In Dict.keys
            Set Wbk = Workbooks.Add(1)
            Wbk.Sheets(1).Name = Ky
            .Range("A5").AutoFilter Field:=4, Criteria1:=Ky
            .Range("A5:R" & UsdRws).SpecialCells(xlVisible).Copy Range("A1")
            Wbk.SaveAS "C:\Users\Fluff\Desktop\test\" & Ky, 51
            Wbk.Close
        Next Ky
        .AutoFilterMode = False
    End With

End Sub

 

[Jsubby3]

created the files but they are still blank

progress though. this time in the original file it copied the header and supplier data and pasted it in the beginning of the sheet

After running macro this was inserted in row 1	Purch. Organization	Plant	Vendor	Name	Purchasing Document	Item
1000	1000	432	Supplier B	123	20
Original Sheet	Purch. Organization	Plant	Vendor	Name	Purchasing Document	Item
1000	1000	214	Supplier A	64741	20
1000	1000	432	Supplier B	123	20

<colgroup><col span="2"><col><col><col><col><col><col></colgroup><tbody>
</tbody>

 

[Fluff]

Do you mean it's copying the data to the same sheet it's copying from?