根据条件从Sheet1复制多个Range并将其粘贴到Sheet2中

Question

我的excel中的vba代码存在问题。我试图让excel自动将基于条件的sheet1的多个范围（B，C，D，F，G）的内容复制到sheet2并排。 示例如下：

这是我的代码，它只将范围B复制到D：

Sub CopyButton()
Dim cell As Range
Dim lastRow As Long, i As Long
lastRow = Range("D" & Rows.Count).End(xlUp).Row
i = 5
For Each cell In Sheets(1).Range("D2:D" & lastRow)
If cell.Value > 0 Then
r=cell.row
range("B" & r & ":D" & r).Copy Sheets(2).Cells(i, 1)
i = i + 1
End If
Next
End Sub

任何帮助都将不胜感激。

Answer 1

可以使用AutoFilter method轻松完成此操作，以使用 xlCellTypeVisible Union method选项隔离行和Range.SpecialCells的xlCellType Enumeration。

Sub xferBCDFG()
    With Worksheets("sheet1")
        If .AutoFilterMode Then .AutoFilterMode = False
        With .Cells(1, 1).CurrentRegion
            .AutoFilter field:=4, Criteria1:="<>0"
            With Union(.Range("B:D"), .Range("F:G")).SpecialCells(xlCellTypeVisible)
                .Copy Destination:=Worksheets("Sheet2").Cells(4, 1)
            End With
        End With
        If .AutoFilterMode Then .AutoFilterMode = False
    End With
End Sub

^{Sheet1上的示例数据}

^{Sheet2上的结果}