Copy data from Main Sheet to multiple sheets based on a criteria

I'm very new to this, but I was wondering if it's possible to write a macro that will allow a workbook to copy data from one worksheet (Main Data Sheet) to the other worksheets in the workbook.  All the worksheets have the same headers in row 1.  Column G in the "Main Data Sheet" consists of different vendor names (Vendor 1, Vendor 2, and Vendor 3).  Each vendor has its own worksheet.  I would like to be able to update the "Main Data Sheet" with new order information and based on the Vendor Name displaying in Column G, I would like that new information to be copied over to its respective Vendor Worksheet on a new blank row so that it does not override the previously copied data.  I do not even know where to begin, but any guidance will be helpful.  Thanks in advance!
Bobby FAsked:
Who is Participating?
Saqib Husain, SyedEngineerCommented:
You can use this macro

Sub post2vendorsht()
    Dim sws As Worksheet
    Dim tws As Worksheet
    Dim cel As Range
    Set sws = Sheets("Main Data Sheet")
    For Each cel In sws.Range("I2:I" & Range("I" & Rows.Count).End(xlUp).Row)
        Set tws = Sheets(cel.Value)
        cel.EntireRow.Copy tws.Range("A" & Rows.Count).End(xlUp).Offset(1)
    Next cel
End Sub
Bobby FAuthor Commented:
Thanks for your comment, Syed.  Can you explain the coding a little?  it's giving me a script error that refers to

Set tws = Sheet(cel.Value)

Is the coding above only for copying the data from the Main Data Sheet?
Saqib Husain, SyedEngineerCommented:
It will copy all rows from row 2 to the end from the Main Data Sheet to the respective vendor sheet.

Are you using the code on the same workbook you uploaded or another workbook?

What is the error and on which line?
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Bobby FAuthor Commented:
Hi, I'm using it on a different workbook.  The actual workbook I need the macro for has sensitive information so I cannot upload it to this site.  So does the coding automatically recognize the sheet based on the name of the vendor in Column I?
Saqib Husain, SyedEngineerCommented:
The vendor sheet is selected based on the value in column I. You must make sure that the spellings are exactly same especially leading and trailing spaces. You still have not reported the error you are getting.
Bobby FAuthor Commented:
Sorry about that. I'm getting the Run-Time error '9': subscript out of range
Saqib Husain, SyedEngineerCommented:
When you get the error click on Debug

If the yellowed line is
Set tws = Sheets(cel.Value)
then select cel.value and press F9. You will see the vendor name. Make sure that a sheet with that name exists.

If the yellowed line is not
Set tws = Sheets(cel.Value)
then tell me which line it is.
Roy CoxGroup Finance ManagerCommented:
It seems a pointless thing to do. All data is best maintained on one sheet ans simply use AutoFilter to view individual vendors

If you really want to do this then this code will do what you want. Automating AutoFilter will be much faster than a Loop. You don't say if you intend keeping existing data in the main Sheet.

Option Explicit

' Module    : Module1
' DateTime  : 24/09/2006 22:48
' Updated   : 2014
' Author    : Roy Cox (royUK)
' Website   :  more examples
' Purpose   :  Create a sheet for each unique name in data
' Disclaimer; This code is offered as is with no guarantees. You may use it in your
'             projects but please leave this header intact.

Sub ExtractToSheets()
    Dim ws     As Worksheet
    Dim wsNew  As Worksheet
    Dim rData  As Range
    Dim rCl    As Range
    Dim sNm    As String
    Set ws = Sheet1

    'extract a list of unique names
    'first clear existing list
    With ws
        Set rData = .Range("A1").CurrentRegion
        rData.Columns(9).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True

        For Each rCl In .Cells(1, .Columns.Count).CurrentRegion
            sNm = rCl.Text
            'add new sheet (only if required-NB uses UDF)
            If WksExists(sNm) Then
                'so clear contents
                'new sheet required
                Set wsNew = Sheets.Add
                wsNew.Move After:=Worksheets(Worksheets.Count)    'move to end
                wsNew.Name = sNm
            End If
            'AutoFilter & copy to relevant sheet
            rData.AutoFilter Field:=9, Criteria1:=sNm
            rData.Copy Destination:=Worksheets(sNm).Cells(1, 1)
        Next rCl
    End With
    ws.Columns(Columns.Count).ClearContents        'remove temporary list
    rData.AutoFilter        'switch off AutoFilter
End Sub

Function WksExists(wksName As String) As Boolean
    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

Open in new window

Bobby FAuthor Commented:
Thank you so much Syed.  It worked!
Roy CoxGroup Finance ManagerCommented:
As I said AutoFilter will be so much faster than a loop!
Bobby FAuthor Commented:
Thank you, Roy.  Is there anyway to change your coding so that it does not create a new worksheet called "Vendor Name"?  It thinks the header is the data I want to copy.  The data also isn't copying over to their individual worksheets.
Bobby FAuthor Commented:
Sorry Roy, I just realized that there's another section in the coding that references column 9.  In the actual file I'm working on, the column is a different number and I only changed the column number in the beginning.  Your coding works perfectly without any run-time error when I encounter blank rows.  Thank you!!!
Roy CoxGroup Finance ManagerCommented:
Thanks for letting me know
vivek aroraCommented:
Dear Saqib Sir,

Your macro seems to work fine but it starts from row 1 instead of row 2. Please review the solution once.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.