Creating multiple lists from one master data table

[Closed]
Report
-
Posts
1320
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
October 8, 2021
-
Hello,

I am trying to create a master data tab where expenses will get coded. I need each subsequent tab to be for a specific account and that tab to pull in each expense that is coded to the appropriate account from the master data. Is there a way to do this?

Thanks!!!

Kelli

2 replies


Yep, you start typing!

We cannot provide a solution turn key. If you were stuck on code or something, we could help out, but we cannot develop a whole process for free, as we are strictly volunteers~!
Do you have an example for posting?

It's kind of fun to do the impossible! -Walter Elias Disney
Posts
1320
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
October 8, 2021
239
Hello KelliG,

Have a look at the following link to a test file that I supplied to another Poster a year or so ago:-

https://www.dropbox.com/s/7vvurpm4ristahr/KelliG%28Master%20sht%20to%20multi%20shts%29.xlsm?dl=0

I believe that it is a similar scenario to yours. I've changed the file name to your name and changed the account data in Column A (Master sheet) to try and represent what you may be trying to do. Click on the "RUN" button to see it all work. The code creates new sheets based on the account name from Column A (Master sheet) and then transfers the relevant row of data to each individual sheet.

See what you think and let us know your thoughts.

I hope that this helps.

Cheerio,
vcoolio.

P.S.: Following is the code attached to the above-mentioned file:-

Option Explicit

Sub CreateSheetsTransferData()
        Dim ar As Variant
        Dim i As Integer
        Dim lr As Long
        Dim ws As Worksheet
        Dim sh As Worksheet

Application.ScreenUpdating = False

lr = Range("A" & Rows.Count).End(xlUp).Row

ar = Sheet1.Range("A3", Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp))
Set sh = Sheet1

For i = LBound(ar) To UBound(ar)
        If Not Evaluate("ISREF('" & ar(i, 1) & "'!A1)") Then
        Worksheets.Add(After:=Sheets(Sheets.Count)).Name = ar(i, 1)
        End If
        Set ws = Worksheets(CStr(ar(i, 1)))
        sh.Range("A2:A" & lr).AutoFilter 1, ar(i, 1)
        sh.[A2].CurrentRegion.Copy ws.[A1]
        ws.Columns.AutoFit
  Next i
    
sh.[A2].AutoFilter
Application.CutCopyMode = False
Application.ScreenUpdating = True
sh.Select
MsgBox "Sheets created/data transfer completed!", vbExclamation, "STATUS"

End Sub