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

Rose401k

New Member
Joined
Aug 14, 2018
Messages
8
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!
 

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.
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]
 
Upvote 0
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:
Upvote 0

Forum statistics

Threads
1,214,661
Messages
6,120,792
Members
448,994
Latest member
rohitsomani

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top