![]() |
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 |
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 |
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 |
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 |
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