根據條件從Sheet1復制多個Range並將其粘貼到Sheet2的Sideside中

Question

我在excel中的vba代碼有問題。 我試圖讓excel根據條件自動將多個范圍（B，C，D，F，G）的內容從sheet1復制到並排的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

使用xlCellTypeVisible xlCellType枚舉選項使用AutoFilter方法隔離行並使用Range.SpecialCells的Union方法可以輕松實現此目的 。

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上的結果}