Split One tab into Multiple Files with Specific Names

J

Jsubby3

New Member
Joined
Oct 24, 2016
Messages
14
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

[TABLE="width: 2157"]
<tbody>[TR]
[TD]Purch. Organization[/TD]
[TD]Plant[/TD]
[TD]Vendor[/TD]
[TD]Name[/TD]
[TD]Purchasing Document[/TD]
[TD]Item[/TD]
[TD]Purchasing Doc. Type[/TD]
[TD]Purchasing Group[/TD]
[TD]Material[/TD]
[TD]Material Description[/TD]
[TD]Schedule Line[/TD]
[TD]Scheduled Quantity[/TD]
[TD]PO UOM[/TD]
[TD]Received Qty Purch UOM[/TD]
[TD]Open Qty Purch UOM[/TD]
[TD]Delivery Date[/TD]
[TD]Stat.-Rel. Del. Date[/TD]
[TD]Delivery Completed[/TD]
[/TR]
[TR]
[TD]1000[/TD]
[TD]1000[/TD]
[TD="align: right"]214[/TD]
[TD]Supplier A[/TD]
[TD="align: right"]64741[/TD]
[TD]20[/TD]
[TD]NB[/TD]
[TD]001[/TD]
[TD]part 1[/TD]
[TD][/TD]
[TD]2[/TD]
[TD]1.000[/TD]
[TD]M2[/TD]
[TD]0.000[/TD]
[TD]1.000[/TD]
[TD]9/30/2017[/TD]
[TD]9/30/2017[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1000[/TD]
[TD]1000[/TD]
[TD="align: right"]432[/TD]
[TD]Supplier B[/TD]
[TD="align: right"]123[/TD]
[TD]20[/TD]
[TD]NB[/TD]
[TD]001[/TD]
[TD]part 2[/TD]
[TD][/TD]
[TD]1[/TD]
[TD]1.000[/TD]
[TD]M2[/TD]
[TD]0.000[/TD]
[TD]1[/TD]
[TD]9/30/2017[/TD]
[TD]9/30/2017[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Sort by date Sort by votes
@RobertSF
The code I've supplied, uses what's called Late Binding & therefore does not require the OP to add any references.
 
Upvote 0

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
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?
 
Upvote 0
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!:banghead:
The dictionary should be looking from D6 downwards not D2 as per
Code: 
        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
 
Upvote 0
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...

[TABLE="width: 878"]
<colgroup><col><col><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]1000[/TD]
[TD]1000[/TD]
[TD="align: right"]432[/TD]
[TD]Supplier B[/TD]
[TD="align: right"]123[/TD]
[TD]20[/TD]
[TD]NB[/TD]
[TD]001[/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[TD] [/TD]
[/TR]
[TR]
[TD]Purch. Organization[/TD]
[TD]Plant[/TD]
[TD]Vendor[/TD]
[TD]Name[/TD]
[TD]Purchasing Document[/TD]
[TD]Item[/TD]
[TD]Purchasing Doc. Type[/TD]
[TD]Purchasing Group[/TD]
[/TR]
[TR]
[TD]1000[/TD]
[TD]1000[/TD]
[TD="align: right"]214[/TD]
[TD]Supplier A[/TD]
[TD="align: right"]64741[/TD]
[TD]20[/TD]
[TD]NB[/TD]
[TD]001[/TD]
[/TR]
[TR]
[TD]1000[/TD]
[TD]1000[/TD]
[TD="align: right"]432[/TD]
[TD]Supplier B[/TD]
[TD="align: right"]123[/TD]
[TD]20[/TD]
[TD]NB[/TD]
[TD]001[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
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...
Click to expand...
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?
 
Upvote 0
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
 
Upvote 0
Give this a go. It will copy the header across, but not sure why the data wasn't getting copied.
Code: 
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
 
Upvote 0
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

[TABLE="width: 757"]
<colgroup><col span="2"><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD="colspan: 2"]After running macro this was inserted in row 1[/TD]
[TD]Purch. Organization[/TD]
[TD]Plant[/TD]
[TD]Vendor[/TD]
[TD]Name[/TD]
[TD]Purchasing Document[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD]1000[/TD]
[TD]1000[/TD]
[TD="align: right"]432[/TD]
[TD]Supplier B[/TD]
[TD="align: right"]123[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="colspan: 2"]Original Sheet[/TD]
[TD]Purch. Organization[/TD]
[TD]Plant[/TD]
[TD]Vendor[/TD]
[TD]Name[/TD]
[TD]Purchasing Document[/TD]
[TD]Item[/TD]
[/TR]
[TR]
[TD]1000[/TD]
[TD]1000[/TD]
[TD="align: right"]214[/TD]
[TD]Supplier A[/TD]
[TD="align: right"]64741[/TD]
[TD]20[/TD]
[/TR]
[TR]
[TD]1000[/TD]
[TD]1000[/TD]
[TD="align: right"]432[/TD]
[TD]Supplier B[/TD]
[TD="align: right"]123[/TD]
[TD]20[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Do you mean it's copying the data to the same sheet it's copying from?
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,223,911
Messages
6,175,326
Members
452,635
Latest member
laura12345

Share this page

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