If cell is Green, copy 50 rows below it and paste to new sheet

Rose401k

New Member
Joined
Aug 14, 2018
Messages
6
Hello, hoping this is an easy solve for you guys!
I have a spreadsheet where I need to regularly copy the bottom half of it to a new spreadsheet while leaving the top half's data behind. The sections are separated by a row of cells with the green color (5296274).
I am thinking this should be an if statement such as (If cell.Interior.color = 5296274 Then) but can't figure out how to tell it to cut and paste the next 50 rows below the green row to the new sheet. Not sure this warrants a loop but looking forward to your solutions. Thanks!
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,380
Office Version
2013
Platform
Windows
Re: How to -If cell is Green, copy 50 rows below it and paste to new sheet

Try this:
This will cut 50 rows below the colored cell in question and paste it into a new sheet.

Code:
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1111856a()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1111856-how-if-cell-green-copy-50-rows-below-paste-new-sheet.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] c [COLOR=Royalblue]As[/COLOR] Range
  
  [COLOR=Royalblue]With[/COLOR] Application
    .FindFormat.Clear
    .FindFormat.Interior.Color = [COLOR=crimson]5296274[/COLOR]
    [COLOR=Royalblue]Set[/COLOR] c = Range([COLOR=brown]"A:A"[/COLOR]).Find(What:=[COLOR=brown]"*"[/COLOR], SearchDirection:=xlNext, SearchFormat:=[COLOR=Royalblue]True[/COLOR])
    
    [COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] c [COLOR=Royalblue]Is[/COLOR] [COLOR=Royalblue]Nothing[/COLOR] [COLOR=Royalblue]Then[/COLOR]
        Rows(c.Row + [COLOR=crimson]1[/COLOR] & [COLOR=brown]":"[/COLOR] & c.Row + [COLOR=crimson]50[/COLOR]).Cut
        Sheets.Add After:=ActiveSheet
        ActiveSheet.paste

    [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]

    .FindFormat.Clear
  [COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]With[/COLOR]

[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,380
Office Version
2013
Platform
Windows
Re: How to -If cell is Green, copy 50 rows below it and paste to new sheet

Sorry, the code in post 2 above won't work if the colored cell in question is empty. So to make it also work on empty cell:

replace this:
Code:
Set c = Range("A:A").Find(What:=[COLOR=#ff0000]"*"[/COLOR], SearchDirection:=xlNext, SearchFormat:=True)
with this:
Code:
Set c = Range("A:A").Find(What:="", SearchDirection:=xlNext, SearchFormat:=True)
 
Last edited:

Forum statistics

Threads
1,082,501
Messages
5,365,942
Members
400,863
Latest member
kimtid

Some videos you may like

This Week's Hot Topics

Top