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

判断表1的A列各单元格字体颜色是否为RGB(255,0,0),如果是,复制整行数据到表2中... 判断表1的A列各单元格字体颜色是否为RGB(255,0,0),如果是,复制整行数据到表2中 展开
 我来答
姓王的wy451

2017-09-23 · TA获得超过48.3万个赞
知道大有可为答主
回答量:8万
采纳率:78%
帮助的人:8681万
展开全部

代码如下:

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
毋巧uH
2017-09-23 · TA获得超过279个赞
知道小有建树答主
回答量:267
采纳率:80%
帮助的人:52.1万
展开全部
以下代码你试试
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
------代码结束-----------
已赞过 已踩过<
你对这个回答的评价是?
评论 收起
推荐律师服务: 若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询

为你推荐:

下载百度知道APP,抢鲜体验
使用百度知道APP,立即抢鲜体验。你的手机镜头里或许有别人想知道的答案。
扫描二维码下载
×

类别

我们会通过消息、邮箱等方式尽快将举报结果通知您。

说明

0/200

提交
取消

辅 助

模 式