vba 从sheet1中挑选出符合条件的单元格将内容复制到sheet2中怎么做？

Question

现在sheet1中我把一些符合给定条件的单元格全标红了，然后我想将A列中没标颜色的单元格复制到sheet2的A列，并连续显示，不必单元格对应，B列也同样如此，如果这一列中没有没标色的，那就留空，也就是列与列要对应。sheet1中一列的数据有多有少无法确定，但能肯定的是他们是连续的，也就是如果有空白格，证明这一列的数据就没了。请问如何编写呢？谢谢！

Answer 1

思路，动态找出sheet1中有多少列，每列多少行，然后判断每列单元格是否有底纹颜色，如果没有，复制，有，跳过。VBA代码可写成如下形式(后面的注释都加了注释符号的，可以完全复制到VBA中运行)。
Sub 复制没有底纹的单元格()
Dim intCol_num%, intRow_num%, i%, intDw_a%, intShRow_num%
intCol_num = Sheets(1).Cells(1, 100).End(xlToLeft).Column '找出sheet1最后一个非空列的列号
For i = 1 To intCol_num Step 1 '循环非空的每一列
intRow_num = Sheets(1).Range("a65536").End(xlUp).Row '找出当前循环到的列的从65536行往上的最后一个非空单元格的行号
For Each ran In Sheets(1).Range(Sheets(1).Cells(1, i), Sheets(1).Cells(intRow_num, i)) '遍历当前循环到的列的非空单元格
intDw_a = ran.Interior.ColorIndex '提出当前单元格背景颜色指数值
If intDw_a < 0 Then
intShRow_num = Sheets(2).Cells(65536, i).End(xlUp).Row '找出sheet2对应列的最后一个非空单元格的行号
If Sheets(2).Cells(1, i).Value <> "" Then
ran.Copy Sheets(2).Cells(intShRow_num + 1, i)
Else
ran.Copy Sheets(2).Cells(intShRow_num, i)
End If
End If
Next
Next
End Sub

Answer 2

Sub test()
'假设sheet1的A列从第一行开始有数据，以下就可以实现
For i = 1 To Sheet1.Cells(1, 1).End(xlDown).Row
If Sheet1.Cells(i, 1).Interior.ColorIndex = xlNone Then
Sheet1.Cells(i, 1).Copy Sheet2.Cells(Sheet2.Cells(65536, 1).End(xlUp).Row + 1, 1)
End If
Next

End Sub

对于B列也是一样，参照这个写法把相应的列换成B列的就可以了本回答被提问者和网友采纳