VBA Copy specific columns to new tab if cells contains specific text

[thedeadzeds]

Hi Guys,

Is there a way to do the following:

Copy columns A,C, E,Y, and D from 'Offsited Data' tab to 'Send CSI' tab and paste as paste values only in that order. So when pasted into the Send CSI tab column A to column A, C to B, E to C, Y to D, and D to E

However, only copy the data where column Z is equal to "Yes" and where column Y is equal to "Dave", "Jim", "Steve", "Ron" and "James".

Hope this makes sense

 

[Yongle]

Try something like this ..

Sub CopyData()
    Dim OD As Worksheet, CSI As Worksheet, Rng As Range, Cel As Range, rw As Long, r As Long
    
    Set OD = Sheets("Offsited Data")
    Set CSI = Sheets("Send CSI")
    Set Rng = OD.Range("A2", OD.Range("A" & Rows.Count).End(xlUp)).Offset(, 25)
    
    For Each Cel In Rng
        rw = Cel.Row
        If Cel = "Yes" Then
            Select Case Cel.Offset(, -1)
                Case "Dave", "Jim", "Steve", "Ron", "James"
                    r = CSI.Range("A" & Rows.Count).End(xlUp).Row + 1
                    With CSI
                    .Cells(r, 1) = OD.Cells(rw, "A")
                    .Cells(r, 2) = OD.Cells(rw, "C")[COLOR=#ff0000][/COLOR]
                    .Cells(r, 3) = OD.Cells(rw, "E")
                    .Cells(r, 4) = OD.Cells(rw, "Y")
                    .Cells(r, 5) = OD.Cells(rw, "D")
                    End With
            End Select
        End If
    Next Cel
End Sub

If the cells are general format then then attributing values is the same as paste values
If the format also needs copying across then add line to do that where required

                   .Cells(r, 2).NumberFormat = OD.Cells(rw, "C").NumberFormat

 

[thedeadzeds]

works great, how do i copy over the headers from the offsited data?

 

[Yongle]

how do i copy over the headers from the offsited data?

Sub CopyData()
    Dim OD As Worksheet, CSI As Worksheet, Rng As Range, Cel As Range, rw As Long, r As Long
    
    Set OD = Sheets("Offsited Data")
    Set CSI = Sheets("Send CSI")
[COLOR=#ff0000]    Set Rng = OD.Range("A2", OD.Range("A" & Rows.Count).End(xlUp)).Offset(, 25)
    With CSI
    .Cells(1, 1) = OD.Cells(1, "A")
    .Cells(1, 2) = OD.Cells(1, "C")
    .Cells(1, 3) = OD.Cells(1, "E")
    .Cells(1, 4) = OD.Cells(1, "Y")
    .Cells(1, 5) = OD.Cells(1, "D")
    End With[/COLOR]
    For Each Cel In Rng
        rw = Cel.Row
        If Cel = "Yes" Then
            Select Case Cel.Offset(, -1)
                Case "Dave", "Jim", "Steve", "Ron", "James"
                    r = CSI.Range("A" & Rows.Count).End(xlUp).Row + 1
                    With CSI
                    .Cells(r, 1) = OD.Cells(rw, "A")
                    .Cells(r, 2) = OD.Cells(rw, "C")
                    .Cells(r, 3) = OD.Cells(rw, "E")
                    .Cells(r, 4) = OD.Cells(rw, "Y")
                    .Cells(r, 5) = OD.Cells(rw, "D")
                    End With
            End Select
        End If
    Next Cel
End Sub