VBA: if any cell in column A = "value", then copy...

[JennV]

Hello,

I'm hoping to get some help with VBA coding. If there are cells in column A that are equal to "value" in Sheet1 then I would like to copy the values of the cells in the same row but in columns D and F to Sheet2.

For example, A4 = "value" so I want to copy the values in D4 and F4 to Sheet2.

Thank you in advance!

 

[JLGWhiz]

Sub t()
Dim rng As Range
With Sheets("Sheet1")
    Set rng = Union(.Range("D:D"), .Range("F:F"))
    .Range("A2", .Cells(Rows.Count, 1).End(xlUp)).AutoFilter 1, "value"
    Intersect(rng, .UsedRange.Offset(1).SpecialCells(xlCellTypeVisible)).Copy Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)(2)
    .AutoFilterMode = False
End With
End Sub

 

[DanteAmor]

Try this

The data is pasted on sheet2 from cell A1

Sub Copy_Values()
    Dim ws As Worksheet, lr As Long
    Set ws = Sheets("Sheet1")
    lr = Range("A" & Rows.Count).End(xlUp).Row
    ws.Range("A1:F" & lr).AutoFilter 1, "value"
    ws.AutoFilter.Range.Range("D2:D" & lr & ",F2:F" & lr).Copy Sheets("Sheet2").Range("A1")
    ws.ShowAllData
End Sub

 

[JennV]

Thank you for the replies! I truly appreciate it!

I just have a follow-up question, is there a way to not copy over the fill/text colors/etc.? My data on Sheet1 has fill/text colors/etc. but I don't want that on Sheet2.

Thank you again!

 

[JLGWhiz]

This will only paste the valuies

Sub t()
Dim rng As Range
   With Sheets("Sheet1")
        Set rng = Union(.Range("D:D"), .Range("F:F"))
        .Range("A2", .Cells(Rows.Count, 1).End(xlUp)).AutoFilter 1, "value"
        Intersect(rng, .UsedRange.Offset(1).SpecialCells(xlCellTypeVisible)).Copy 
        Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial xlPasteValues
        .AutoFilterMode = False
    End With
End Sub

 

[DanteAmor]

Thank you for the replies! I truly appreciate it!

I just have a follow-up question, is there a way to not copy over the fill/text colors/etc.? My data on Sheet1 has fill/text colors/etc. but I don't want that on Sheet2.

Thank you again!

Use this

    Dim ws As Worksheet, lr As Long
    Set ws = Sheets("Sheet1")
    lr = Range("A" & Rows.Count).End(xlUp).Row
    ws.Range("A1:F" & lr).AutoFilter 1, "value"
    ws.AutoFilter.Range.Range("D2:D" & lr & ",F2:F" & lr).Copy 
    Sheets("Sheet2").Range("A1").[COLOR=#333333]PasteSpecial xlPasteValues[/COLOR]
    ws.ShowAllData
End Sub

 

[JennV]

Thank you both very, very much! It works great!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.