How to auto copy data from master list to sub worksheets based on data value in one column
Category: [Excel] Demo Available
How to auto copy data from master list to sub worksheets based on data value in one column
Requirement:
The user has a macro that takes the data from 2 sub worksheets and copies that across to a master list at the click of a button, but the user is really needing the reverse. The user is needing a macro to copy data inputted into the master list into 2 separate worksheets in same workbook according to what age a person is.
In a nutshell the master list is the database of all youths that attend sports training. The sub worksheets need to be populated by age ie U12s on one and U14s (or anyone with an age older than 12) on the other . These sub sheets will then be the ones printed to form the base of the termly registers.
The user is aware I could just use the filter buttons on the master list to separate out those rows required, but a couple of less IT literate people will be in the main using the information so it needs to be fool proof and as easy to use as possible, hence the requirement to input into the master and then press one button for that info to be magically split per age category.
Solution:
Code:
Sub TransferData()
Dim ar As Variant
Dim sh As Worksheet, ws As Worksheet
Dim i As Integer
Dim lr As Long
Set sh = Sheets("Master List")
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
sh.Range("X3:X" & lr) = "=IF(G3<=12,""U12s"",""U14s"")" '---->Formula placed in Column X of Master List to define sheets in the array.
ar = sh.Range("X3", sh.Range("X" & sh.Rows.Count).End(xlUp))
Application.ScreenUpdating = False
For i = 1 To UBound(ar)
Set ws = Sheets(ar(i, 1))
ws.UsedRange.Offset(1).ClearContents
sh.Range("X2:X" & lr).AutoFilter 1, ar(i, 1)
sh.Range("A3:G" & lr).Copy
ws.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
ws.Columns.AutoFit
sh.[X2].AutoFilter
Next i
sh.Select
sh.[A1].AutoFilter
sh.Columns(24).ClearContents
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Data transfer completed!", vbExclamation, "Status"
End Sub
The code uses a helper column (Column X so its out of the way) to define the sheet names from the ages in Column G by using a formula which is inserted by the same code.
It then transfers the relevant rows of data (from columns A to G) to the relevant age sheet. The age sheets are refreshed each time a transfer of data takes place.
I've attached your sample file with the code implemented and assigned to the button you placed on the sheet. Click on the button to see the code at work.
Code:
Sub TransferData()
Dim ar As Variant
Dim sh As Worksheet, ws As Worksheet
Dim i As Integer
Dim lr As Long
Set sh = Sheets("Master List")
lr = sh.Range("A" & Rows.Count).End(xlUp).Row
sh.Range("X3:X" & lr) = "=IF(G3<=12,""U12s"",""U14s"")" '---->Formula placed in Column X of Master List to define sheets in the array.
ar = sh.Range("X3", sh.Range("X" & sh.Rows.Count).End(xlUp))
Application.ScreenUpdating = False
For i = 1 To UBound(ar)
Set ws = Sheets(ar(i, 1))
ws.UsedRange.Offset(1).ClearContents
sh.Range("X2:X" & lr).AutoFilter 1, ar(i, 1)
sh.Range("A3:G" & lr).Copy
ws.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
ws.Columns.AutoFit
sh.[X2].AutoFilter
Next i
sh.Select
sh.[A1].AutoFilter
sh.Columns(24).ClearContents
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Data transfer completed!", vbExclamation, "Status"
End Sub
The code uses a helper column (Column X so its out of the way) to define the sheet names from the ages in Column G by using a formula which is inserted by the same code.
It then transfers the relevant rows of data (from columns A to G) to the relevant age sheet. The age sheets are refreshed each time a transfer of data takes place.
vcoolio has attached your sample file with the code implemented and assigned to the button you placed on the sheet. Click on the button to see the code at work.
Obtained from the OzGrid Help Forum.
Solution provided by vcoolio.
See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets
See also:
| How to copy master sheet as values and automatically set new name |
| How to paste value when creating a master summary sheet |
| How to use a macro to copy data from multiple workbooks to one master sheet in another workbook |
| How to list & display all files in user folder, select file and copy specific tab into master sheet |
Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.