Question

以下代码适用于复制整行，如何制作，所以我只复制第一列。

我尝试改变范围而没有成功？条件在J中，唯一要复制的列应该是第一列。

Dim cell As Range
Dim lastRow As Long, i As Long

lastRow = Range("B" & Rows.Count).End(xlUp).Row
i = 1

For Each cell In Sheets(1).Range("J1:J" & lastRow)
    If cell.Value = 1 Then
        cell.EntireRow.Copy Sheets(5).Cells(i, 1)
        i = i + 1
    End If
Next

End Sub

非常感谢！

Answer 1

试

Dim cell As Range
Dim lastRow As Long, i As Long

lastRow = Range("B" & Rows.Count).End(xlUp).Row
i = 1

For Each cell In Sheets(1).Range("J1:J" & lastRow)
    If cell.Value = 1 Then
        cells(cell.row,1).Copy Sheets(5).Cells(i, 1)
        i = i + 1
    End If
Next

End Sub

Answer 2

Dim cell As Range
Dim lastRow As Long, i As Long    
lastRow = Range("B" & Rows.Count).End(xlUp).Row
i = 1

For Each cell In Sheets(1).Range("J1:J" & lastRow)
    If cell.Value = 1 Then
        cell.End(xlToLeft).Copy Sheets(5).Cells(i, 1)
        i = i + 1
    End If
Next
End Sub

Answer 3

只需将EntireRow切换为EntireColumn，就这么简单！ ;）

Dim rCell As Range
Dim lastRow As Long, i As Long

lastRow = Range("B" & Rows.Count).End(xlUp).Row
i = 1

For Each rCell In Sheets(1).Range("J1:J" & lastRow)
    If rcell.Value = 1 Then
        rcell.EntireColumn.Copy Sheets(5).Cells(1, i)
        i = i + 1
    End If
Next rCell

如果符合条件，则仅复制一列（需要调整现有代码）

3 个答案: