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

Question

I'm trying to copy data from columns C,D,J,P when the value in column I is "O"

I'm very new at VBA and the best approach I could think of what to use an IF statement, but I haven't been able to paste more than two consecutive columns.

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 doesn't work like that: try this:

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

Your approach itself is exactly right. Looping over a range of cells is usually the most efficient way of handling data. In your current code you'd simply need to repeat the copy for the cells missing inside the loop.

In VBA, however, "pasting" in a seperate line of code if rarely necessary. It is also good coding practise to define all your variables at the top of your code.

Here is different approach using the For each -loop and summing up the wanted range with the Union method:

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

This, of course, loops over all cells in Column C. If you want to limit the range, you can simply adjust rSource to your needs.