Move data from one sheet to mutlipe sheets based on sheet name

DK27

New Member
Joined
Feb 13, 2023
Messages
1
Office Version
  1. 365
Platform
  1. Windows
Hi,

Wondering if someone may be able to assist here. I have a set of data in a sheet sorted by client name (multiple lines per client) I also have an individual tab for each client name which i created using a pivot table and the show report filter pages feature. I would like to see if it is possibe to run a macro/formula that moves the data from the master sheet to the corresponding sheet for each client. I believe thier is around 400 clients, so 400 tabs/sheets. Any help will be greatly appreciated!


Book1
ABCDEFGHIJKLMN
1management OrgApi Taskidclient Namejobnumberinvoice Numberdescriptiontaskinvoiced Datemailing Address 2mailing Address 1management Orginvoice Descriptioncustomer Oninvoice Total Ex
2111 Customhouse LtdJic6XyRQPFcsCg==111 Customhouse Ltd252072431169PM SERVICE: Auto Door and Roller Door - June 2022 (Auto x1 and Roller x1 - Mar Jun Sep Dec) 1.2.22 Sfp note added: Please sign-in on the "Asbestos Management contractors attendance sheet" Register is in the corridor off the foyer on the ground floor. Also a covid scan in doc. Code C3459. Can call Malcolm 021 053 2234 prop manager if any issues 11.12.18 Sfp note added: Swipe card required from workshop for the roller door. iSoft House 111 - 113 Customhouse Quay31/07/2022Attention: Malcolm Shute111 Customhouse QuayPM SERVICE: Auto Door and Roller Door - June 2022PM ServiceXX
3111 Customhouse LtdJic6Sy1RTF8hCg==111 Customhouse Ltd246589425731PM SERVICE: Auto Door and Roller Door - March 2022 (Auto x1 and Roller x1 - Mar Jun Sep Dec) 11.12.18 Sfp note added: Swipe card required from workshop for the roller door. 1.2.22 Sfp note added: Please sign in on the "Asbestos Management contractors attendance sheet" iSoft House 111 - 113 Customhouse Quay27/04/2022Attention: Malcolm Shute111 Customhouse QuayPM SERVICE: Auto Door and Roller Door - March 2022PM ServiceXX
4111 Customhouse LtdJic6VydQLFctCg==111 Customhouse Ltd258478437661PM SERVICE: Auto Door and Roller Door - September 2022 (Auto x1 and Roller x1 - Mar Jun Sep Dec) 1.2.22 Sfp note added: Please sign-in on the "Asbestos Management contractors attendance sheet" Register is in the corridor off the foyer on the ground floor. Also a covid scan in doc. Code C3459. Can call Malcolm 021 053 2234 prop manager if any issues 11.12.18 Sfp note added: Swipe card required from workshop for the roller door. iSoft House 111 - 113 Customhouse Quay30/11/2022Attention: Malcolm Shute111 Customhouse QuayPM SERVICE: Auto Door and Roller Door - September 2022PM ServiceXX
5120 The Terrace BC 86105Jic6TyNQPFsjCg==120 The Terrace BC 86105243298424878PM SERVICE: Auto Door January 2022 (Auto x1 - Jan Apr Jul Oct and Access x3 - Apr Oct)Quest Hotel31/03/2022Quest on Terrace120 The TerracePM SERVICE: Auto Door January 2022PM ServiceXX
6120 The Terrace BC 86105Jic6RyJSXFMgCg==120 The Terrace BC 86105248498427656PM SERVICE: Auto and Manual Doors - April 2022 (Auto x1 - Jan Apr Jul Oct and Access x3 - Apr Oct)Quest Hotel31/05/2022Quest on Terrace120 The TerracePM SERVICE: Auto and Manual Doors - April 2022PM ServiceXX
7120 The Terrace BC 86105Jic6UyZQTFMhCg==120 The Terrace BC 86105261154439154PM SERVICE: Auto and Manual Doors - October 2022 (Auto x1 - Jan Apr Jul Oct and Access x3 - Apr Oct)Quest Hotel31/12/2022Quest on Terrace120 The TerracePM SERVICE: Auto and Manual Doors - October 2022PM ServiceXX
8120 The Terrace BC 86105Jic6XyxRPFMtCg==120 The Terrace BC 86105254369432805PM SERVICE: Auto Door - July 2022 (Auto x1 - Jan Apr Jul Oct and Access x3 - Apr Oct)Quest Hotel31/08/2022Quest on Terrace120 The TerracePM SERVICE: Auto Door - July 2022PM ServiceXX
930 Seconds LtdJic6RyRQPFcjCg==30 Seconds Ltd247027430167PM SERVICE: Pallet Wrapper - March 2022 (x1 Pallet Wrapper Mar Sep) 11.12.20 Sfp note added: No service agreement in place programmed into system to track for Werner accounts charge up please 9 Garland Street Matamata26/07/20229 Garland StreetPO Box 46PM SERVICE: Pallet Wrapper - March 2022PM ServiceXX
10385 Queen Street LimitedJic6QyBSTFcsCg==385 Queen Street Limited250853429938PM SERVICE: Auto Door Roller Door and Manual Doors - April October 2022 (x1 Auto door Jan Apr Jul Oct x1 Roller Door and x25 manual doors April Oct) 21.4.22 Sfp note added: New contract received re-activated service University of Otago House21/07/2022Private Bag 92142Victoria West StreetPM SERVICE: Auto Door Roller Door and Manual Doors - April 2022PM ServiceXX
11385 Queen Street LimitedJic6Xy1QPEMmCg==385 Queen Street Limited254781432809PM SERVICE: Auto Door - July 2022 (x1 Auto door Jan Apr Jul Oct x1 Roller Door and x25 manual doors April Oct) 21.4.22 Sfp note added: New contract received re-activated service University of Otago House31/08/2022Private Bag 92142Victoria West StreetPM SERVICE: Auto Door - July 2022PM ServiceXX
12385 Queen Street LimitedJic6UyZQTEsiCg==385 Queen Street Limited261216439195PM SERVICE: Auto Door Roller Door and Manual Doors - October 2022 (x1 Auto door Jan Apr Jul Oct x1 Roller Door and x25 manual doors April Oct) 21.4.22 Sfp note added: New contract received re-activated service University of Otago House31/12/2022Private Bag 92142Victoria West StreetPM SERVICE: Auto Door Roller Door and Manual Doors - October 2022PM ServiceXX
13525 Blenheim Road LtdJic6VydSXE8mCg==525 Blenheim Road Ltd258832437669PM SERVICE: Roller Doors - September 2022 (x6 Roller Doors Mar Sep) 21.12.18 Sfp note added: Scissor Lift needed & allowed for in service 11.3.21 Please call and book a time to attend manager Dan 03 348 8422 7.4.21 Sfp note added: As per Mayra - client advised use PO on seervice - PO99000067Tyre General30/11/2022PO Box 13-0060ArmaghPM SERVICE: Roller Doors - September 2022PO99000067XX
14525 Blenheim Road LtdJic6RyRQLEsnCg==525 Blenheim Road Ltd246979425451PM SERVICE: Roller Doors - March 2022 (x6 Roller Doors Mar Sep) 21.12.18 Sfp note added: Scissor Lift needed & allowed for in service 11.3.21 Please call and book a time to attend manager Steve 03 348 8422 7.4.21 Sfp note added: As per Mayra - client advised use PO on seervice - PO99000067Tyre General14/04/2022PO Box 13-0060ArmaghPM SERVICE: Roller Doors - March 2022 PO99000067XX
15A & AM Muollo Family TrustJic6RyJSXFMhCg==A & AM Muollo Family Trust248497428202PM SERVICE: Auto Door and Roller Door - April 2022 (Auto x1 and Roller x1 - Jan Apr Jul Oct)Promotus House15/06/202258 Oriental Bay ParadeWellingtonPM SERVICE: Auto Door and Roller Door - April 2022PM ServiceXX
16A & AM Muollo Family TrustJic6TyNRPEskCg==A & AM Muollo Family Trust243498425119PM SERVICE: Auto Door and Roller Door - January 2022 (Auto x1 and Roller x1 - Jan Apr Jul Oct)Promotus House31/03/202258 Oriental Bay ParadeWellingtonPM SERVICE: Auto Door and Roller Door - January 2022 PM ServiceXX
17A & AM Muollo Family TrustJic6Xy1QXEciCg==A & AM Muollo Family Trust254596432833PM SERVICE: Auto Door and Roller Door - July 2022 (Auto x1 and Roller x1 - Jan Apr Jul Oct) 25.3.22 Sfp note added: Luigi Muollo requested we send an email once service is completed to confirm service has been done to: t.amuollo@xtra.co.nzPromotus House31/08/202258 Oriental Bay ParadeWellingtonPM SERVICE: Auto Door and Roller Door - July 2022PM ServiceXX
18A & AM Muollo Family TrustJic6UyZQTFMmCg==A & AM Muollo Family Trust261153439158PM SERVICE: Auto Door and Roller Door - October 2022 (Auto x1 and Roller x1 - Jan Apr Jul Oct) 25.3.22 Sfp note added: Luigi Muollo requested we send an email once service is completed to confirm service has been done to: t.amuollo@xtra.co.nzPromotus House31/12/202258 Oriental Bay ParadeWellingtonPM SERVICE: Auto Door and Roller Door - October 2022PM ServiceXX
19A B Investments LimitedJic6RyRQLEchCg==A B Investments Limited246971427177PM SERVICE: Roller Doors - March 2022 (x3 Roller doors Mar Jun Sep Dec x2 Rubbish Room Roller Doors Mar Sep) 11.3.21 sfp note added: Call Sheryle Wotton to book a time 027 669 7977 - Tuesday mornings are best 29.3.18 Sfp note added: Scissor lift needed for service (accounts - allowed for in costs) 13.3.19 Sfp note added: Building B roller door added to schedule door comes up Mon – Fri 8.30am so a service can be undertaken in the morning prior to opening. Swipe card needed for access please collect from Colliers as per Sheryle Wooton @ ColliersThe Crossing Christchurch26/05/2022T/A The CrossingPO Box 1047 LinwoodPM SERVICE: Roller Doors - March 2022 RD01 - Entry Lane Car Park RD02 - Exit Lane From Car Park RD03 - Rubbish Room L/H RD04 - Rubbish Room R/H RD05 - Building BPM ServiceXX
20A B Investments LimitedJic6TyRQLDchCg==A B Investments Limited241428423456PM SERVICE: Roller Doors - December 2021 (x3 Roller doors Mar Jun Sep Dec x2 Rubbish Room Roller Doors Mar Sep) 11.3.21 sfp note added: Call Sheryle Wotton to book a time 027 669 7977 - Tuesday mornings are best 29.3.18 Sfp note added: Scissor lift needed for service (accounts - allowed for in costs) 13.3.19 Sfp note added: Building B roller door added to schedule door comes up Mon – Fri 8.30am so a service can be undertaken in the morning prior to opening. Swipe card needed for access please collect from Colliers as per Sheryle Wooton @ ColliersThe Crossing Christchurch10/03/2022T/A The CrossingPO Box 1047 LinwoodPM SERVICE: 3 x Roller Doors - December 2021 RD01 - Entry Lane Car Park RD02 - Exit Lane From Car Park RD05 - Building BPM ServiceXX
21A B Investments LimitedJic6VydSXEctCg==A B Investments Limited258817437673PM SERVICE: Roller Doors - September 2022 (x3 Roller doors Mar Jun Sep Dec x2 Rubbish Room Roller Doors Mar Sep) 13.09.22 EB note added: 2x techs book with Sheryle - early am or late pm scissor lift req. 28.3.22 Sfp note added: Site want serivce done after hours need to re do contract to allow for after hours JUNE 22 11.3.21 sfp note added: Call Sheryle Wotton to book a time 027 669 7977 - Tuesday mornings are best 29.3.18 Sfp note added: Scissor lift needed for service (accounts - allowed for in costs) 13.3.19 Sfp note added: Building B roller door added to schedule door comes up Mon – Fri 8.30am so a service can be undertaken in the morning prior to opening. Swipe card needed for access please collect from Colliers as per Sheryle Wooton @ ColliersThe Crossing Christchurch30/11/2022T/A The CrossingPO Box 1047 LinwoodPM SERVICE: Roller Doors - September 2022 RD01 - Entry Lane Car Park RD02 - Exit Lane From Car Park RD03 - Rubbish Room L/H RD04 - Rubbish Room R/H RD05 - Building BPM ServiceXX
22A B Investments LimitedJic6XyVRTF8jCg==A B Investments Limited252485431557PM SERVICE: Roller Doors - June 2022 (x3 Roller doors Mar Jun Sep Dec x2 Rubbish Room Roller Doors Mar Sep) 28.3.22 Sfp note added: Site want serivce done after hours need to re do contract to allow for after hours JUNE 22 11.3.21 sfp note added: Call Sheryle Wotton to book a time 027 669 7977 - Tuesday mornings are best 29.3.18 Sfp note added: Scissor lift needed for service (accounts - allowed for in costs) 13.3.19 Sfp note added: Building B roller door added to schedule door comes up Mon – Fri 8.30am so a service can be undertaken in the morning prior to opening. Swipe card needed for access please collect from Colliers as per Sheryle Wooton @ ColliersThe Crossing Christchurch16/08/2022T/A The CrossingPO Box 1047 LinwoodPM SERVICE: Roller Doors - June 2022 RD01 - Entry Lane Car Park RD02 - Exit Lane From Car Park RD05 - Building BPM ServiceXX
23AceDoors South Island LtdJic6SydQPFMjCg==AceDoors South Island Ltd245276425163PM SERVICE: Auto Doors - February 2022 (x3 Auto doors Feb Aug) Note: Client advised we will not sign off 12A servicing 6 monthly. Site advised they have IQP to sign off 3.1 Toyota Rangiora31/03/2022PO Box 76105Manukau CityPM SERVICE: Auto Doors - February 2022 CRS24559XX
24AceDoors South Island LtdJic6WyNQTFsgCg==AceDoors South Island Ltd256974434650PM SERVICE: Auto Doors - August 2022 (x3 Auto doors Feb Aug) Note: Client advised we will not sign off 12A servicing 6 monthly. Site advised they have IQP to sign off 3.1 Toyota Rangiora30/09/2022PO Box 76105Manukau CityPM SERVICE: Auto Doors - August 2022CRS24559XX
25ADHB Facilities & DevJic6TyJSTEskCg==ADHB Facilities & Dev243092423746BWOF Inspection - 3.1: Breakout/Failsafe Auto/Slide Egress Door. Site extn 22547 - January 2022 Asset No: 112159 BUILDING G15-G17 GREENLANE- NWGreenlane Clinical Centre16/03/2022A07 Aquaheat2 Park RoadBWOF Inspection - 3.1: Breakout/Failsafe Auto/Slide Egress Door - January 2022 Asset No: 112159 BUILDING G15-G17 GREENLANE- NW 20/1/2022: For BWOF inspection on auto doors as requested.P0183158 PO3095873XX
26ADHB Facilities & DevJic6TyJSTEshCg==ADHB Facilities & Dev243093422198BWOF Inspection - 3.1: Breakout/Failsafe Auto/Slide Egress Door - January 2022 Asset No. 101904 BUILDING G04 GREENLANE - AmbulatoryGreenlane Clinical Centre14/02/2022A07 Aquaheat2 Park RoadBWOF Inspection - 3.1: Breakout/Failsafe Auto/Slide Egress Door - January 2022 Asset No. 101904 BUILDING G04 GREENLANE - Ambulatory Sign in locate door and set up safety requirements. Complete job safety analysis and carry out BWOF Inspection. Pack up after job completion and complete sign out process. 21/1/2022: Carry out BWOF Inspection of egress door as required.P0183154 PO3095873XX
27ADHB Facilities & DevJic6TyJSTEsgCg==ADHB Facilities & Dev243094422199BWOF Inspection - 3.1: Breakout/Failsafe Auto/Slide Egress Door - January 2022 Asset No. 101908 - Building G08 Greenlane - Eye ClinicGreenlane Clinical Centre14/02/2022A07 Aquaheat2 Park RoadBWOF Inspection - 3.1: Breakout/Failsafe Auto/Slide Egress Door - January 2022 Asset No. 101908 - Building G08 Greenlane - Eye Clinic Sign in locate door and set up safety requirements. Complete job safety analysis and carry out BWOF Inspection . Pack up after job completion and complete sign out process. 20/1/2022: Carry out BWOF Inspection on egress door as required.P0183156 PO3095873XX
Sheet1
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Do the client sheets already have data in them?

If so then can I assume that you want to add onto the end of the existing data?
 
Upvote 0
This code will, for each unique value in a specified column, copy all rows for each unique value
into a sheet with that value as it's name.

A new sheet will be created if it does not exist already.

Call the code using this line:

Call subFilterAndCopyData("Master", 3, "UniqueList")

The procedure has three arguments:

1. The name of the sheet containing the source data.
2. The column number containing the value to split the data on.
3. A worksheet name that is used temporarily to store the unique list of values held in the column specified.

VBA Code:
Public Sub subFilterAndCopyData(strSourceSheet As String, intSplitByColumn As Integer, strUniqueListSheetName As String)
Dim Ws As Worksheet
Dim WsTarget As Worksheet
Dim WsMaster As Worksheet
Dim arrUniqueList() As Variant
Dim rngList As Range
Dim i As Integer
Dim blnExists As Boolean
Dim lngLastRow As Long
Dim rngFiltered As Range
Dim blnInvalid As Boolean
Dim x As Integer
Dim strInvalidNames As String
Dim strInvalidChars As String
Dim rngMaster As Range
Dim intCounter As Integer
Dim rngSplitBy As Range

    ActiveWorkbook.Save
    
    strInvalidChars = "/\[]*:?"
        
    Set WsMaster = Worksheets(strSourceSheet)
        
    WsMaster.AutoFilterMode = False
    
    Set rngMaster = WsMaster.Range("A1").CurrentRegion
       
    Set rngSplitBy = WsMaster.Range("A1").CurrentRegion.Columns(intSplitByColumn)
    Set rngSplitBy = rngSplitBy.Offset(1, 0).Resize(rngMaster.Rows.Count - 1, 1)
    
    lngLastRow = WsMaster.Range("A" & Rows.Count).End(xlUp).Row
    
    blnExists = False
    For Each Ws In Worksheets
        If Ws.Name = strUniqueListSheetName Then
            blnExists = True
        End If
    Next Ws
    If Not blnExists Then
        Worksheets.Add after:=Worksheets(Sheets.Count)
        ActiveSheet.Name = strUniqueListSheetName
    End If
        
    With Worksheets(strUniqueListSheetName).Range("A1")
        .Clear
        .Formula2 = "=UNIQUE(" & WsMaster.Name & "!" & rngSplitBy.Address & ",FALSE,FALSE)"
        Set rngList = .CurrentRegion.Columns(1)
        arrUniqueList = rngList
    End With
        
    For i = 1 To UBound(arrUniqueList, 1)
    
        blnInvalid = False
        
        For x = 1 To Len(arrUniqueList(i, 1))
            If InStr(1, strInvalidChars, Mid(arrUniqueList(i, 1), x, 1), vbTextCompare) > 0 Then
                strInvalidNames = strInvalidNames & vbCrLf & arrUniqueList(i, 1)
                blnInvalid = True
            End If
        Next x
        
        If Not blnInvalid Then
        
            blnExists = False
                    
            For Each Ws In Worksheets
                If Ws.Name = arrUniqueList(i, 1) Then
                    blnExists = True
                End If
            Next Ws
            
            ' Create worksheet if it does not exist.
           If Not blnExists Then
                Worksheets.Add after:=Worksheets(Sheets.Count)
                ActiveSheet.Name = arrUniqueList(i, 1)
                Set WsTarget = Worksheets(CStr(arrUniqueList(i, 1)))
            Else
                Set WsTarget = Worksheets(arrUniqueList(i, 1))
                WsTarget.Cells.ClearContents
            End If

            WsMaster.Rows(1).Copy Destination:=WsTarget.Range("A1")
            intCounter = intCounter + 1
                        
            ' Filter worksheet and copy data.
            With WsMaster
                rngMaster.AutoFilter Field:=intSplitByColumn, Criteria1:=arrUniqueList(i, 1)
                With .AutoFilter.Range
                    Set rngFiltered = .Resize(.Rows.Count - 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)
                    rngFiltered.Copy Destination:=Worksheets(arrUniqueList(i, 1)).Range("A2")
                    Worksheets(arrUniqueList(i, 1)).Cells.EntireColumn.AutoFit
                 End With
                 .AutoFilterMode = False
            End With
            
        End If
                
    Next i
    
    Application.DisplayAlerts = False
    Worksheets("UniqueList").Delete
    Application.DisplayAlerts = True
    
    If strInvalidNames <> "" Then
        MsgBox "These worksheets have not been created." & vbCrLf & strInvalidNames, vbCritical, "Invalid Worksheet Names"
    End If
    
End Sub
 
Upvote 0

Forum statistics

Threads
1,214,593
Messages
6,120,435
Members
448,961
Latest member
nzskater

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