excel vba 代码求复制整行数据至其他表格中

Question

判断表1的A列各单元格字体颜色是否为RGB(255,0,0)，如果是，复制整行数据到表2中

Answer 1

代码如下：

Sub 复制整行数据()
Dim I&, Rm&
Rm = Cells.Rows.Count
With Sheet1
   For I = 1 To .Range("A" & Rm).End(3).Row
      If .Range("A" & I).Font.Color = RGB(255, 0, 0) Then .Rows(I).Copy Sheet2.Range("A" & Rm).End(3).Offset(1)
   Next
End With
End Sub

Answer 2

以下代码你试试
sheet1 是判断的工作表 改成你自己的
sheet2 是粘贴的工作表 改成你自己的
------代码开始-------
Sub 判断复制()
Dim a%, b, c
Do
b = b + 1 '行数累加
If Sheets("Sheet1").Cells(b, 1) = "" Then Exit Do '判断单元格是否为空，为空时结束代码运行 也可以改成行数多少时结束如:if B>100 then exit sub
a = Cells(b, 1).Font.ColorIndex '获取字体颜色
If a = 3 Then '判断字体颜色是否为红色（VBA中红色是3/excel中RGB(255,0,0)是红色）
Sheets("Sheet1").Select '选中工作表
Rows(b & ":" & b).Select '判断正确选择该行
Selection.Copy '复制
Sheets("sheet2").Select '选择sheet2工作表（sheet2可以更改为其它工作表）
Range("A65536").Select
Selection.End(xlUp).Select
c = ActiveCell.Row + 1
Range("A" & c).Select '选中最后使用单元格的下一个A列的值
ActiveSheet.Paste '粘贴
Sheets("Sheet1").Select '选中判断条件的单元格
End If
Loop
Sheets("Sheet2").Select
Application.CutCopyMode = False
End Sub
------代码结束-----------

Answer 3

以下代码你试试
sheet1 是判断的工作表 改成你自己的
sheet2 是粘贴的工作表 改成你自己的
------代码开始-------
Sub 判断复制()
Dim a%, b, c
Do
b = b + 1 '行数累加
If Sheets("Sheet1").Cells(b, 1) = "" Then Exit Do '判断单元格是否为空，为空时结束代码运行 也可以改成行数多少时结束如:if B>100 then exit sub
a = Cells(b, 1).Font.ColorIndex '获取字体颜色
If a = 3 Then '判断字体颜色是否为红色（VBA中红色是3/excel中RGB(255,0,0)是红色）
Sheets("Sheet1").Select '选中工作表
Rows(b & ":" & b).Select '判断正确选择该行
Selection.Copy '复制
Sheets("sheet2").Select '选择sheet2工作表（sheet2可以更改为其它工作表）
Range("A65536").Select
Selection.End(xlUp).Select
c = ActiveCell.Row + 1
Range("A" & c).Select '选中最后使用单元格的下一个A列的值
ActiveSheet.Paste '粘贴
Sheets("Sheet1").Select '选中判断条件的单元格
End If
Loop
Sheets("Sheet2").Select
Application.CutCopyMode = False
End Sub
------代码结束-----------