Creating a new tab in a workbook with data from one of the tabs in a workbook

[DebW310161]

I have a register of names, address, phone numbers and activities that are applicable to each person. There are 5 different activities that could be assigned to a person.

I want to creat 5 tabs, each titled one of the 5 activities in the main spreadsheet.

How do I extract data from main spreadsheet to create these individual spreadsheets.

Tab 1 needs to find people (with all their relevant details, name, address etc) from main spreadsheet that do Cardio

Tab 2 needs to find people (with all their relevant details, name, address etc) from main spreadsheet that do Weights

etc etc

I have a :-
Name column
Address column
Phone # column
Activity column

in the main spreadsheet.

Also, I want to be able to add names to the main spreadsheet at a later date but have them automatically put into their applicable spreadsheet.

Can this be done.

Thank you

Deb

 

[vcoolio]

Hello Deb,

See if the following code does the task for you (untested):-

Sub Test()

              Dim i As Integer, lr As Long
              Dim sh As Worksheet, ws As Worksheet, ar As Variant
        
Application.ScreenUpdating = False
        
              Set sh = Sheet1
              lr = sh.Range("A" & Rows.Count).End(xlUp).Row
              sh.Range("D1:D" & lr).AdvancedFilter 2, , sh.[X10], 1
              ar = sh.Range("D2", sh.Range("D" & sh.Rows.Count).End(xlUp))
              
       For i = 1 To UBound(ar)
              If Not Evaluate("ISREF('" & CStr(ar(i, 1)) & "'!A1)") Then
                    Sheets.Add(After:=Sheets(Worksheets.Count)).Name = ar(i, 1)
              End If
                    
              Set ws = Sheets(CStr(ar(i, 1)))
              ws.UsedRange.Clear
                    
              With sh.[A1].CurrentRegion
                   .AutoFilter 4, ar(i, 1)
                   .Copy ws.[A1]
                   .AutoFilter
              End With
              
              ws.Columns.AutoFit
              
       Next i

              sh.Columns("X").Clear
              sh.Select

Application.ScreenUpdating = True

End Sub

I've assumed that Column D is the activity column.
Place the code in a standard module and assign it to a button.

I hope that this helps.

Cheerio,
vcoolio.