仅当所选列中的单元格不为空白时才复制行答案

【问题标题】：Copy rows only if cells are not blank in selected columns仅当所选列中的单元格不为空白时才复制行
【发布时间】：2017-12-03 21:10:04
【问题描述】：

下面的代码（代码一）目前工作正常，其中选定的列被复制并粘贴到 A 列中的单个条件。

但是，我正在尝试添加另一个条件，如果 N 到 R 列为空白，excel 将不会复制单元格。我尝试编写代码二（如下），但运行时错误“9”下标超出范围。

我能否在更改代码 2 时获得一些帮助，以便正确过滤列。

代码一

Dim i As Long
Dim iLastRow As Long
Dim iTarget As Long

With Worksheets("Okay")

    iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 1 To iLastRow
        If .Cells(i, "A").Value = "Welcome" Then
            iTarget = iTarget + 1
            .Cells(i, "B").Copy
            Worksheets("Sheet7").Range("A" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "C").Copy
            Worksheets("Sheet7").Range("B" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "D").Copy
            Worksheets("Sheet7").Range("C" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "E").Copy
            Worksheets("Sheet7").Range("D" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "F").Copy
            Worksheets("Sheet7").Range("F" & iTarget + 1).PasteSpecial xlPasteValues
            Worksheets("Sheet7").Range("G" & iTarget + 1).Value = "How"
            Worksheets("Sheet7").Range("H" & iTarget + 1).Value = "Are"
            Worksheets("Sheet7").Range("I" & iTarget + 1).Value = "You"
            Worksheets("Sheet7").Range("J" & iTarget + 1).Value = "Okay"
            .Cells(i, "N").Copy
            Worksheets("Sheet7").Range("K" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "O").Copy
            Worksheets("Sheet7").Range("L" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "P").Copy
            Worksheets("Sheet7").Range("M" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "Q").Copy
            Worksheets("Sheet7").Range("N" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "R").Copy
            Worksheets("Sheet7").Range("O" & iTarget + 1).PasteSpecial xlPasteValues
        End If
    Next i

End With

代码二

Dim i As Long
Dim iLastRow As Long
Dim iTarget As Long

With Worksheets("Okay")

    iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 1 To iLastRow
        If .Cells(i, "A").Value = "Welcome" Then
        If .Cells(i, "N").Value <> "" Then
        If .Cells(i, "O").Value <> "" Then
        If .Cells(i, "P").Value <> "" Then
        If .Cells(i, "Q").Value <> "" Then
        If .Cells(i, "R").Value <> "" Then
            iTarget = iTarget + 1
            .Cells(i, "B").Copy
            Worksheets("Sheet7").Range("A" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "C").Copy
            Worksheets("Sheet7").Range("B" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "D").Copy
            Worksheets("Sheet7").Range("C" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "E").Copy
            Worksheets("Sheet7").Range("D" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "F").Copy
            Worksheets("Sheet7").Range("F" & iTarget + 1).PasteSpecial xlPasteValues
            Worksheets("Sheet7").Range("G" & iTarget + 1).Value = "Hello"
            Worksheets("Sheet7").Range("H" & iTarget + 1).Value = "How"
            Worksheets("Sheet7").Range("I" & iTarget + 1).Value = "Are"
            Worksheets("Sheet7").Range("J" & iTarget + 1).Value = "You"
            .Cells(i, "N").Copy
            Worksheets("Sheet7").Range("K" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "O").Copy
            Worksheets("Sheet7").Range("L" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "P").Copy
            Worksheets("Sheet7").Range("M" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "Q").Copy
            Worksheets("Sheet7").Range("N" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "R").Copy
            Worksheets("Sheet7").Range("O" & iTarget + 1).PasteSpecial xlPasteValues
            .Cells(i, "G").Copy
            Worksheets("Sheet7").Range("P" & iTarget + 1).PasteSpecial xlPasteValues
        End If
        End If
        End If
        End If
        End If
        End If
    Next i

End With

【问题讨论】：

仅 .AutoFilter 列 N:R 不为空，然后复制过滤后的数据。在这个网站上被询问和回答了 无数次。
而且，如果@Jeeped 的建议没有帮助，至少告诉我们哪行在您当前的代码中给出了错误。
除非我在要复制的数据中添加另一个帮助列，否则自动过滤器将不起作用。如果填充了五列（N-R 列）中的任何一列，我仍然需要复制和粘贴。我收到错误的行是第一个粘贴行 >> Worksheets("Sheet7").Range("A" & iTarget + 1).PasteSpecial xlPasteValues
FWIW - 代码 2 对我有用，没有错误。
我强烈建议你摆脱复制/粘贴 - .Cells(i, "B").Copy Worksheets("Sheet7").Range("A" & iTarget + 1).PasteSpecial xlPasteValues 可以写成Worksheets("Sheet7").Range("A" & iTarget + 1).Value = .Cells(i, "B").Value，这样可以避免使用剪贴板，从而提高速度并减少用户引起的错误在宏运行时复制/粘贴。

标签： vba excel multiple-columns copy-paste

【解决方案1】：

如果您在该行收到“下标超出范围”错误

Worksheets("Sheet7").Range("A" & iTarget + 1).PasteSpecial xlPasteValues

那么最可能的原因（或者，我认为，唯一的原因）是您没有名为“Sheet7”的工作表。

注意：您可以通过不使用复制/粘贴来改进您的代码。复制/粘贴速度很慢，如果您的用户在等待宏运行时在其他应用程序中执行另一次手动复制/粘贴，也会导致问题。试试这个稍微重构的代码：

Dim i As Long
Dim iLastRow As Long
Dim iTarget As Long
iTarget = 1 ' initialise value to avoid lots of "+ 1"s

With Worksheets("Okay")    
    iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    For i = 1 To iLastRow
        If .Cells(i, "A").Value = "Welcome" Then
        If .Cells(i, "N").Value <> "" Then
        If .Cells(i, "O").Value <> "" Then
        If .Cells(i, "P").Value <> "" Then
        If .Cells(i, "Q").Value <> "" Then
        If .Cells(i, "R").Value <> "" Then
            iTarget = iTarget + 1
            'Set 4 columns at once
            Worksheets("Sheet7").Range("A" & iTarget).Resize(1, 4).Value = .Cells(i, "B").Resize(1, 4).Value
            Worksheets("Sheet7").Range("F" & iTarget).Value = .Cells(i, "F").Value
            Worksheets("Sheet7").Range("G" & iTarget).Value = "Hello"
            Worksheets("Sheet7").Range("H" & iTarget).Value = "How"
            Worksheets("Sheet7").Range("I" & iTarget).Value = "Are"
            Worksheets("Sheet7").Range("J" & iTarget).Value = "You"
            'Set 5 columns at once
            Worksheets("Sheet7").Range("K" & iTarget).Resize(1, 5).Value = .Cells(i, "N").Resize(1, 5).Value
            Worksheets("Sheet7").Range("P" & iTarget).Value = .Cells(i, "G").Value
        End If
        End If
        End If
        End If
        End If
        End If
    Next i    
End With

【讨论】：