如果单元格有文本,则复制一行

Copy a Row if a Cell has Text

我正在尝试编写一个宏来复制一行,如果该行中的特定单元格包含文本(C 列),我搜索了互联网并找到了处理复制具有特定文本的行的宏,但我想要编写一个无论单元格中包含什么文本都可以复制它的文本。

例如,如果有 30 行但只有 10 行包含 C 列中的文本,我希望它复制这 10 行并将它们粘贴到 'Action Summary' sheet.

目前我正在使用条件格式为没有文本的任何单元格着色,然后过滤掉它们并复制剩余的行,但这有点混乱,我想知道是否有更简洁的方法。

谢谢。

您可以使用 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

更新 Sheet 名称以满足您的要求。

然后是这样的:

将 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

它循环遍历 sheet 的前 30 行,然后在 c 列(即第 3 列)中找到一个值后,它循环遍历 "Action Summary" sheet 递增 y 变量,直到找到要粘贴的空白行,然后将 sheet 1 的整行 x 复制到 "Action Summary" sheet.[= 的行 y 中11=]