Copy coloured cells to another spreadsheet

[ELEANOR1690]

[TABLE="width: 571"]
<tbody>[TR]
[TD]ROUTINE MAINTENANCE[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Bus No[/TD]
[TD]Job No[/TD]
[TD="colspan: 3"]Type[/TD]
[TD]ins[/TD]
[TD]VOR[/TD]
[/TR]
[TR]
[TD]12345[/TD]
[TD]NE[/TD]
[TD]TYRE REPAIR[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]12345[/TD]
[TD]NE[/TD]
[TD]TYRE REPAIR[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]12345[/TD]
[TD]NE[/TD]
[TD]TYRE REPAIR[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]12345[/TD]
[TD]NE[/TD]
[TD]TYRE REPAIR[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]12345[/TD]
[TD]NE[/TD]
[TD]TYRE REPAIR[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD]12345[/TD]
[TD]NE[/TD]
[TD]TYRE REPAIR[/TD]
[TD][/TD]
[TD][/TD]
[TD]Y[/TD]
[TD]Y[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD="colspan: 3"][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

If the above range as no background colour I would like it to be copied to the next sheet.

Sheets are in date range IE sheet 1 is named 16-SEP-2018 sheet 2 17-SEP-2018 sheet 3 18-SEP-2018 ETC

The idea is that any cells not highlighted in the range have to be copied to the next days worksheet

Can anyone help

 

[vcoolio]

Hello Eleanor1690,

Try the following code placed in a standard module and assigned to a button on each sheet:-

Sub CopyData()

Dim sh As Worksheet: Set sh = ActiveSheet

Application.ScreenUpdating = False

With sh.[A1].CurrentRegion
        .AutoFilter 1, , 12  
        .Offset(1).EntireRow.Copy
        sh.Next.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
        sh.Next.Columns.AutoFit
        .AutoFilter
End With

Application.ScreenUpdating = True
Application.CutCopyMode = False
sh.Next.Select

End Sub

The code assumes that your data starts in row2 with headings in row1.
The code also assumes that you'll high-light entire rows of data starting in Column A.

I hope that this helps.

Cheerio,
vcoolio.

P.S. Following is the link to a sample file with the code implemented. Click on the "RUN" button on each sheet to see it work.
Non high-lighted rows of data are transferred to the next sheet.

http://ge.tt/2ZMOXQr2

 

[ELEANOR1690]

HiThank you for this the data starts row 8 to row 18 with headers in rows 1-7 how do I reflect this in the code?Also I cannot get the link http://ge.tt/#/2ZMOXQr2 to work

 

[vcoolio]

Hello Eleanor1690,

Change this line in the code:-

With sh.[A1].CurrentRegion

to

With sh.Range("A7", sh.Range("A" & sh.Rows.Count).End(xlUp))

I've just tried the link again and it works just fine. Click on the link which will take you to the link site. Once it has loaded, you'll see this:-

Download Transfer data to subsequent shts(filter on non coloured rows).xlsm

Click on "Download" which will then open the file for you.

BTW, you won't need a button on your very last sheet.

Cheerio,
vcoolio.

 

[ELEANOR1690]

HiThank you so much for your help.Sorry I should have said that it is not entire rows it is column A8 to G18 is it possible to amend the code.

 

[vcoolio]

Hello Eleanor,

I now assume that you have data past Column G but you only need non high-lighted rows of data from Columns A:G transferred to the next sheet. If this is the case, then the following amendment to the code should do:-

Sub CopyData()

Dim sh As Worksheet: Set sh = ActiveSheet

Application.ScreenUpdating = False

With sh.Range("A7", sh.Range("A" & sh.Rows.Count).End(xlUp))        
        .AutoFilter 1, , 12
        [COLOR=#ff0000].Columns("A:G").Offset(1).Copy[/COLOR]
        sh.Next.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlValues
        sh.Next.Columns.AutoFit
        .AutoFilter
End With

Application.ScreenUpdating = True
Application.CutCopyMode = False
sh.Next.Select

End Sub

However, you do mention just the range A8:G18. Does this mean that there is data below row 18 but you only need the "data block" A8:G18 dealt with?

Cheerio,
vcoolio.

 

[ELEANOR1690]

Hithank you you have been a starYes there is data below the area A8 to G18 does this mean the code needs adjusting?

 

[ELEANOR1690]

Hi I have tried the latest version of the code and it is copying the data over but not to the correct cells and not just the cells that are hilighted.Is there a way I can attach the spreadsheet so that you can see it.Regards Eleanor

 

[ELEANOR1690]

Sorry The last message should have read and not just the cells that are not hilighted

 

[vcoolio]

Hello Eleanor,

Up load a sample of your workbook to a free file sharing site such as Drop Box then post the link to your file in your next post. If your data is sensitive then please use dummy data.

Cheerio,
vcoolio.