copying data from one table to many

[rtandrew]

I am looking for a way to copy data rows from one master sheet into other existing excel files based on codes located in column "A" of the master sheet. There are column headers in both the master and individual sheets, with the data rows starting on row 4. Is there a way to do this without triggering the "save as"?

Thanks.

 

[Andrew Poulsom]

To get help I think you need to tell us the names of your existing excel files and how those names relate to the data in column A of the master sheet.

 

[rtandrew]

The names of the files could be anything at this point. They are currently the names of employees with their first initial (e.g. "andrewst"). The codes in column A of the master sheet are unique staff id's created by the accounting department (format e.g. "-1111").

I was planning on relating the ids to file names by creating a new column and using a vlookup to essentially recode the rows with a new set of ids which would also be the names of the individual spreadsheets. However, I am not sure this is the way to go.

 

[Andrew Poulsom]

You will have to do something like that, otherwise you won't know which file to open to copy the data.

 

[rtandrew]

OK. I can manage that part. But once I create a new column A that corresponds to the names of the excel files I want to copy rows to, is there a reliable method to manage the copying from one master file to multiple individual excel files?

 

[Norie]

Matthew

This could be possible using Advanced Filter, in code.

 

[rtandrew]

I just looked for the term advanced filter in my VBA books and found no information. Can you provide an example?

Thanks

 

[Andrew Poulsom]

Here is some code that will copy columns A:H on Sheet1 to new workbooks named after the entries in column A:

Sub Test()
    Dim Sh As Worksheet
    Dim Rng As Range
    Dim c As Range
    Dim List As New Collection
    Dim Item As Variant
    Dim WB As Workbook
    Application.ScreenUpdating = False
''   *** Change Sheet name to suit ***
    Set Sh = Worksheets("Sheet1")
    Set Rng = Sh.Range("A2:A" & Sh.Range("A65536").End(xlUp).Row)
    On Error Resume Next
    For Each c In Rng
        List.Add c.Value, CStr(c.Value)
    Next c
    On Error GoTo 0
    Set Rng = Sh.Range("A1:H" & Sh.Range("A65536").End(xlUp).Row)
    For Each Item In List
        Set WB = Workbooks.Add
        Rng.AutoFilter Field:=1, Criteria1:=Item
        Rng.SpecialCells(xlCellTypeVisible).Copy WB.Worksheets(1).Range("A1")
        Rng.AutoFilter
        With WB
            .SaveAs ThisWorkbook.Path & "\" & Item & ".xls"
            .Close
        End With
    Next Item
    Sh.Activate
    Application.ScreenUpdating = True
End Sub

Maybe yo can adapt it to suit.

 

[Norie]

Matthew

This code will create a new workbook for each unique item in column A.

Each workbook will have one sheet containing only data based on each unique item.

Sub DistributeRows()
Dim wbNew As Workbook
Dim wsData As Worksheet
Dim wsCrit As Worksheet
Dim wsNew As Worksheet
Dim rngCrit As Range
Dim LastRow As Long
    
    Set wsData = Worksheets("Master (2)")
    Set wsCrit = Worksheets.Add
    
    LastRow = wsData.Range("A" & Rows.Count).End(xlUp).Row
    
    wsData.Range("A1:A" & LastRow).AdvancedFilter action:=xlFilterCopy, CopyToRange:=wsCrit.Range("A1"), Unique:=True
    
    Set rngCrit = wsCrit.Range("A2")
    While rngCrit.Value <> ""
        Set wsNew = Worksheets.Add
        wsData.Range("A1:E" & LastRow).AdvancedFilter action:=xlFilterCopy, CriteriaRange:=rngCrit.Offset(-1).Resize(2), CopyToRange:=wsNew.Range("A1"), Unique:=True
        wsNew.Name = rngCrit
        wsNew.Copy
        Set wbNew = ActiveWorkbook
        wbNew.SaveAs ThisWorkbook.Path & "\" & rngCrit
        wbNew.Close SaveChanges:=True
        Application.DisplayAlerts = False
        wsNew.Delete
        rngCrit.EntireRow.Delete
        Set rngCrit = wsCrit.Range("A2")
    Wend
    
    wsCrit.Delete
    Application.DisplayAlerts = True
End Sub

Note the workbooks will be saved in the same directory as the workbook with the code and will be named after the unique items.

 

[rtandrew]

Thank you both. I will try out both of your suggestions now.