ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Selection.Copy - ActiveSheet.Paste to blank cells (https://www.excelbanter.com/excel-programming/367627-selection-copy-activesheet-paste-blank-cells.html)

AFSSkier

Selection.Copy - ActiveSheet.Paste to blank cells
 
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

Jim Jackson

Selection.Copy - ActiveSheet.Paste to blank cells
 
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


Dave Peterson

Selection.Copy - ActiveSheet.Paste to blank cells
 
Debra Dalgleish shows some techniques (manually and via code):
http://www.contextures.com/xlDataEntry02.html

If this isn't part of a larger routine, I've always found the manual method much
easier/quicker to do than finding the macro and running it.



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


--

Dave Peterson

AFSSkier

Selection.Copy - ActiveSheet.Paste to blank cells
 
This works awesome!
--
Thanks, Kevin


"Dave Peterson" wrote:

Debra Dalgleish shows some techniques (manually and via code):
http://www.contextures.com/xlDataEntry02.html

If this isn't part of a larger routine, I've always found the manual method much
easier/quicker to do than finding the macro and running it.



AFSSkier wrote:

I€„¢m 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). I€„¢m 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


--

Dave Peterson


AFSSkier

Selection.Copy - ActiveSheet.Paste to blank cells
 
I copied & pasted your script into a test macro & received an error message.
"Compile Error: Loop without Do".
--
Thanks, Kevin


"Jim Jackson" wrote:

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



All times are GMT +1. The time now is 03:49 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com