将sheet1中的某一行数据，按不同底色筛选并拷贝至其它sheet中，请问能做到吗？

cmpesr

这本来是发在 函数与公式 里发的，但是发现我想实现的功能似乎无法通过简单的函数实现，所以发来这里看看。

题目描述的不是很清楚，还是一边看图一边说吧……
实际的表，跟1图格式是一样的。A列是项目名称，同种项目会用不同颜色标出，后面的就是具体内容。中间灰色的行是时间信息。
我想做到的是，sheet2中能自动读出sheet1中相同标记颜色的项目，然后把所在行的数据自动拷贝过来。比如图2这样，把黄色底色的拷贝到sheet2中，其它的sheet可以拷贝其它颜色的项目。这是第一步。
第二步是数据的自动更新。又分两步。
1、比如说sheet1该行后面的具体内容有变动的话，后面的sheet中对应的数据也会自动更新。
2、如果项目名称的底色变了，比如从黄色变成红色，那后面筛选黄色的sheet中会把这些数据清除，而后面筛选红色的sheet中会出现该行数据。
第三部是能做到时间行的共同拷贝是最好。不过时间行是没有什么明显标记的，所以我觉得是有点儿不太可能……于是我改了一下表的格式，像图3一样，标题独占两行，时间行和内容行。这样是否能做到连时间行都一起拷贝过去呢？结果会像图4那样。

格式什么的可以先不考虑，当然，一起拷贝过去最好……

不知道这个要求是不是异想天开。请各位大神不吝赐教……哪怕只有部分要求能做到也可以。

在此谢过。

opiona

1. Sub OPIONA()
   
2.     Set SH2 = Worksheets("Sheet2")
   
3.     Set SH3 = Worksheets("Sheet3")
   
4.     SH3.Rows("3:65536").Delete Shift:=xlUp
   
5.     X = 3
   
6.     For I = 1 To SH2.Range("A65536").End(3).Row
   
7.         If SH2.Cells(I, 1).Interior.Color = SH3.Cells(1, 1).Interior.Color Then
   
8.             SH2.Rows(I & ":" & I).Copy SH3.Cells(X, 1)
   
9.             X = X + 1
   
10.         End If
    
11.     Next
    
12. End Sub

复制代码

opiona

在sheet3第一个单元格 设置要汇总的颜色
test.rar (15.05 KB, 下载次数: 11)

2018-6-18 19:39 上传

点击文件名下载附件

cmpesr

opiona 发表于 2018-6-18 19:39
在sheet3第一个单元格 设置要汇总的颜色

今天才看到，十分感谢朋友，你真帮了我大忙了。