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

Posted 2023-04-01

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

代码如下：

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

参考技术A 以下代码你试试
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
------代码结束-----------

Excel VBA宏 - 带有格式的复制插入数据的问题

我有一个电子表格，我在宏中使用AutoFill插入行并复制粘贴数据（在第1列的任何行中）。在宏 - 七天，它在其他行上工作正常但不是如果数据在第一行并且第一行具有白色背景。请指导。这是代码：

Sub Macro7Day()

 If ActiveCell.Column = 1 Then
        Dim numCopies As Long
        numCopies = 6

        Dim i As Long
        For i = 1 To numCopies
            Rows(ActiveCell.Row + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Next i
        Range("A5:E5").Copy
        Range(ActiveCell, ActiveCell.Offset(numCopies, 4)).PasteSpecial xlPasteFormats
        ActiveCell.AutoFill Destination:=Range(ActiveCell, ActiveCell.Offset(numCopies, 0)), Type:=xlFillDefault 'xlFillCopy
End If

End Sub

答案

根据我的测试，您的代码在第一列的任何行中复制带有格式的插入数据时运行良好。但是，正如您所描述的那样，您的代码在其他行上可以正常工作，但如果数据位于第一行且第一行具有白色背景，则不会。我想知道“第一行有白色背景”是什么意思还是第一行没有数据？希望你为此更新。

谢谢，

雪