Something like this should work. Your specific setup will dictate any
modifications.

Sheets("sheet1").activate
Range("A1").activate
retval = activecell
For each cell in Sheets
Do
If Activecell = "" And Activecell.offset(0,1) = "" then
exit for
elseIf Activecell = "" then
Activecell = retval
else
Activecell.offset(1,0).activate
Loop
Do
Next
End Sub
--
Best wishes,

Jim


"AFSSkier" wrote:

Im looking for a macro routine that basically copies each of the "GUIDE
CAT." headers down through each blank cell below it next to each item (see
before & after below). Im currently double clicking each header to copy
down. Then "End-Down" to the next set. The ActiveCell.Range needs to be
variable & run until all blanks are filled with the header from above.

Befo
GUIDE CATEGORY DESCRIPTION
BABY CARE
BABY BOTTLE 2PK 4Z
BABY BOTTLE CLEAR DECO 1PK 8 Z
BEAUTY CARE
BATH ACCESSERIES
ANIMAL BATH BUDDIES W/SUCTION
TITLED BATH BUFFER
COSMETIC/FRAGRANCE
BTY BASICS 6PC MKUP BRSH/MIRRO

After:
GUIDE CATEGORY DESCRIPTION
BABY CARE
BABY CARE BABY BOTTLE 2PK 4Z
BABY CARE BABY BOTTLE CLEAR DECO 1PK 8 Z
BEAUTY CARE
BATH ACCESSERIES
BATH ACCESSERIES ANIMAL BATH BUDDIES W/SUCTION
BATH ACCESSERIES TITLED BATH BUFFER
COSMETIC/FRAGRANCE
COSMETIC/FRAGRANCE BTY BASICS 6PC MKUP BRSH/MIRRO


MACRO:
Range("B1").Select
Selection.End(xlDown).Select
Selection.Copy
ActiveCell.Offset(1, 0).Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
ActiveCell.Range("A1:A61").Select
ActiveSheet.Paste
€˜ (repeats until all blank cells are filled w/header from above)
End Sub

--
Thanks, Kevin