如何从vba中的多个列复制和粘贴

我试图从列C，D，J，P复制数据时，列I中的值是“O”

我在VBA方面非常新，并且我可以想到使用IF语句的最佳方法，但是我无法粘贴两个以上的连续列。

sub firsttry Dim bodata As Worksheet Dim bopresentation As Worksheet Set bodata = Worksheets("BO Data") Set bopresentation = Worksheets("BO presentation") bodata.Activate Dim i As Integer i = 1 For i = 1 To 20 If bodata.Cells(i, 9).Value = "O" Then bodata.Range(Cells(i, 3), Cells(i, 4)).Copy bopresentation.Range("b20").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll) Else End if Next end sub 

Answer 1

Range不能这样工作：试试这个：

 For i = 1 To 20 If bodata.Cells(i, 9).Value = "O" Then Application.Union(bodata.Cells(i, 3), bodata.Cells(i, 4), _ bodata.Cells(i, 10), bodata.Cells(i, 16)).Copy bopresentation.Range("b20").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteAll) End if Next 

Answer 2

你的方法本身是完全正确的。 遍历一系列单元格通常是处理数据的最有效的方法。 在你当前的代码中，你只需要重复循环内缺less的单元格的副本。

然而，在VBA中，如果很less需要的话，可以在一行代码中“粘贴”。 在代码顶部定义所有的variables也是很好的编码习惯。

这里有不同的方法，使用For each合并用Union方法总结想要的范围：

 Dim rCell as Range Dim rSource as Range 'Define the source range as the entire column C With ThisWorkbook.Worksheets("BO Data") Set rSource = .Range("C1", .Cells(Rows.Count, 3).End(xlUp)) End with 'Loop over each cell in the source range and check for its value For each rCell in rSource If rCell.Value = "0" Then 'If requirement met copy defined cells to target location With ThisWorkbook.Worksheets("BO Data") Application.Union(.Cells(rCell.Row, 3), _ .Cells(rCell.Row, 4), _ .Cells(rCell.Row, 10), _ .Cells(rCell.Row, 16) _ ).Copy Destination = ThisWorkbook.Worksheets("BO Presentation").Range("B2") End With Next rCell 

当然，这将在列C中的所有单元格上循环。如果要限制范围，可以简单地根据需要调整rSource。