Vba 如果单元格中有文本，则复制行

我试图编写一个宏来复制一行，如果该行中的某个特定单元格包含文本列C，我搜索了internet，找到了可以复制具有特定文本的行的宏，但我想编写一个可以复制该行的宏，而不管该单元格中包含什么文本

例如，如果有30行，但C列中只有10行包含文本，我希望它复制这10行并将其粘贴到“操作摘要”工作表中

目前，我正在使用条件格式给没有文本的单元格着色，然后过滤掉它们并复制剩余的行，但这有点混乱，我想知道是否有更干净的方法来做

---

谢谢。

您可以使用If语句确定单元格是否包含文本，例如：

If IsNumeric(rCell.Value) = False And _
IsError(rCell.Value) = False And _
IsDate(rCell.Value) = False Then

第一行检查值不是数字，第二行检查值不是公式中的错误消息，最后一行检查值不是日期，因为这些值可能被误认为文本，具体取决于它们的格式

然后添加代码以复制已找到的行。

尝试此操作

Private Sub CopyNonBlank()
    Dim destWS As Worksheet ' Destination worksheet
    Set destWS = ThisWorkbook.Worksheets("Action Summary")
    Dim i As Long: i = 1
    For Each cell In Range("C2:C32")
        If Len(cell.Value) > 0 Then ' if cell is not empty lenght would be greater than 0
            destWS.Range("A" & i).Value = cell.Value
            i = i + 1
        End If
    Next cell
End Sub

也许：

Sub SmartCopy()
    Dim s1 As Worksheet, s2 As Worksheet
    Dim N As Long, i As Long, j As Long
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Action Summary")
    N = s1.Cells(Rows.Count, "C").End(xlUp).Row
    j = 1
    For i = 1 To N
        If s1.Cells(i, "C").Value = "" Then
        Else
            s1.Cells(i, "C").EntireRow.Copy s2.Cells(j, 1)
            j = j + 1
        End If
    Next i
End Sub

---

更新工作表名称以符合您的要求。

类似以下内容：

Dim y作为整数

y = 1
For x = 1 To 30
    If Sheets(1).Cells(x, 3) <> "" Then
        Do While Sheets("Action Summary").Cells(y, 3) <> ""
            y = y + 1
        Loop
        Sheets(1).Rows(x).Copy Destination:=Sheets("Action Summary").Rows(y)
        y = 1
    End If

Next x

---

它循环遍历工作表1的前30行，然后在c列（即第3列）中找到一个值时，它循环遍历操作摘要工作表的c列值，递增y变量，直到找到要粘贴的空行，然后将工作表1的整个x行复制到操作摘要工作表的y行。

，你只需要检查一下这个单元格是否是空的。遍历行，然后检查列c：如果是Cellsx，那么是3。。。其中x代表您的行。这几乎满足了我的要求，但我需要它将整行复制到汇总表中，当C列中有文本并且有一个标题行时，它应该开始将它们粘贴到第2行。argh这几乎是完美的，它完全满足了我的要求，但我需要它从第7行开始搜索，抱歉，我对此非常陌生！