Populate multiple worksheets

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

How can I write a maco/code that wil distribute data from one worksheet into
multiple worksheets within the same workbook?

For instance column I need a separate worksheet for each 'Name' (Column A).
So, all the data pertaining to ADAMCZYK, DARCY will transfer into a separate
worksheet, etc.

Name Mod 2006 Min 2006 Max
ADAMCZYK, DARCY CT 0.00 0.00
ADAMCZYK, DARCY DG 0.00 14,148.00
ADAMCZYK, DARCY MG 2.00 10,090.00
ADAMCZYK, DARCY MR 0.00 0.00
ADAMCZYK, DARCY OS 8.00 3,860.00
ADKINS, MARK CT 0.00 0.00
ADKINS, MARK DG 0.00 0.00
ADKINS, MARK MR 0.00 0.00
ADKINS, MARK OS 0.00 0.00
ADKINS, MARK RF 0.00 0.00
AMRAMI, KIMBERLY CT 0.00 0.00
AMRAMI, KIMBERLY DG 1.00 30,424.00
AMRAMI, KIMBERLY MG 0.00 0.00
AMRAMI, KIMBERLY MR 5.00 30,482.00
AMRAMI, KIMBERLY OS 0.00 0.00
AMRAMI, KIMBERLY RF 0.00 0.00
ANDREWS, JAMES CT 0.00 0.00
ANDREWS, JAMES DG 0.00 0.00
ANDREWS, JAMES OS 75.00 2,627.00
ANDREWS, JAMES RF 0.00 0.00
ANDREWS, JAMES US 49.00 7,207.00
ANDREWS, JAMES V&I 12.00 7,527.00
 
You may want to look at the way Ron de Bruin and Debra Dalgleish approached it:

Ron de Bruin's EasyFilter addin:
http://www.rondebruin.nl/easyfilter.htm

Code from Debra Dalgleish's site:
http://www.contextures.com/excelfiles.html

Create New Sheets from Filtered List -- uses an Advanced Filter to create
separate sheet of orders for each sales rep visible in a filtered list; macro
automates the filter. AdvFilterRepFiltered.xls 35 kb

Update Sheets from Master -- uses an Advanced Filter to send data from
Master sheet to individual worksheets -- replaces old data with current.
AdvFilterCity.xls 55 kb

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
 
This code assumes that the headings are in row three and that the names
are in the first column.

Sub wkst()
Dim wksht As Worksheet
Dim rcell As Range
Dim rg1 As Range
Dim cpyrg As Range
Dim hdrg As Range
Dim dest As Range
Dim rgend As Range

Set rgend = ActiveSheet.Range("a65536").End(xlUp)

Set rg1 = ActiveSheet.Range("a4:a" & rgend.Row)

Set hdrg = ActiveSheet.Range("a3").EntireRow

For Each rcell In rg1
If rcell.Value <> "" Then
On Error Resume Next

Set wksht = Worksheets(rcell.Value)

If wksht Is Nothing Then
Set wksht = Worksheets.Add
wksht.Name = rcell.Value
hdrg.Copy
wksht.Range("a3").PasteSpecial
End If

On Error GoTo 0

Set cpyrg = rcell.EntireRow

Set dest = wksht.Range("a65536").End(xlUp).Offset(1, 0)

cpyrg.Copy
dest.PasteSpecial
End If
Next


End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top