Excel - loop through table listobject, copy cells to each sheet (attached)

[davedave24]

I have a sheet with 4 columns that can be sorted with a Table listobject by Customer name. There is a worksheet for each customer.

I need my macro to select each customer in the Table, and copy their data to their own worksheet. I've got this working for 1 customer, but this method would mean having 50+ buttons, 1 for each customer, that all need to be pressed in turn.

Is there a way to reference the customer name in the listobject and select that customer's worksheet?

I've attached my workbook (hopefully you can d/l from Google Drive)

Cheers

 

[SkipVought]

hi,

Please post your code, if you want help with your code.

BTW, why would you have a separate sheet for each customer? Why not use an AutoFilter on ONE SHEET to select customer? Just wondering out loud, as each additional sheet is an overhead in size and maintenance.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[davedave24]

It's an accounts/invoice spreadsheet. I'm not sure, it's just the way they've got it set up.

My main problem is that I don't know the properties of the Table listobject - how do I reference each item?
I was thinking of a dirty way of doing it - loop through the workbook, set the filter to each sheetname in turn, do the procedure, and skip errors, but it's a bit messy.

Sub sort2()

    Dim cust As String
    Application.ScreenUpdating = False
    cust = "Severn"
    With Sheets("Customers")
        'filter
        .ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=cust
        

        
        'go to A1, move down 1 cell
        .Range("B2").Select

        'select to the bottom right corner
        Selection.End(xlDown).Select
        Range("B2").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        
        'copy selection
        Selection.Copy
    End With
    
    
    
    With Sheets(cust)
        .Select
        .Range("A1").Select
        
        'move to the next empty row
        .Cells(Rows.Count, 1).End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        
        'paste the selection
        Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    End With
    
    'unselect
    Sheets("Customers").Select
    ActiveSheet.Range("A2").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    MsgBox "Done!"
    
End Sub

 

[SkipVought]

How about something like this...

Sub sort2()
'[b]you need a UNIQUE list of customers to drive this process
'I assume that this list is named [highlight]CustLst[/highlight][/b]
    Dim cust As String, r As Range

    Application.ScreenUpdating = False
    
    With Sheets("Customers")
        For Each r In [CustLst]
            .ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=r.Value
            .Range(.Cells(2, "B"), .Cells(.[B2].End(xlDown).Row, .[B2].End(xlToRight).Column)).SpecialCells(xlCellTypeVisible).Copy
        
            Sheets(r.Value).[A1].End(xlDown).Offset(1).PasteSpecial xlPasteValues
        Next
    End With
    Application.ScreenUpdating = True
    
    MsgBox "Done!"
    
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[davedave24]

Thx Skip. I'm having trouble setting custLst. Are you setting it as a variant or object? I was trying this (probably way off):

 Dim custLst as Object
Set CustLst = ThisWorkbook.Sheets("Customers").ListObjects("Table1").DataBodyRange

 

[SkipVought]

1) Every List/Table must have a row of headings in row1

2) SELECT the list

3) Formulas > Define Names > Create from selection -- Create Name in TOP row.

This creates a Named Range, using the heading value at the top of the selection. Named Range is an essential feature in Excel.

Check out Use names to clarify formulas in Excel HELP.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}