View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
bobbo bobbo is offline
external usenet poster
 
Posts: 56
Default Populate multiple worksheets

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

Vicki wrote:
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