Copy Row

[Geoff Varner]

Happy Monday!

I would like to write code where an entire row is copied based on the contents of a particular cell in the row and then paste that row on a different sheet in the workbook. For example:

1 2 d a b
1 3 d c b
1 4 d a b

I would like for the code to look for the letter c in the 4th column then copy the entire row and past it.

Can anyone help please?

Thanks,

Geoff

 

[Mike Blackman]

Hi,

Try;

Sub MoveRows()

Dim lRow As Long

lRow = Range("A" & Rows.count).End(xlUp).Row

Columns("D").AutoFilter Field:=1, Criteria1:="c"
Range("A1:E" & lRow).SpecialCells(xlCellTypeVisible).Copy Sheets(2).Range("A1")
ActiveSheet.ShowAllData

End Sub

 

[Geoff Varner]

I think this will work but can I specify the name of a worksheet to copy from as well. Copy from sheet (CC New Hire) to sheet (SPOKC).

Thanks.

 

[MickG]

Try this:-
Alter destination sheet to suit.
NB:- This code will add Additional "c" Data to subsequent rows in destination sheet.

Sub cc()
Dim Rng As Range, Dn As Range, Last As Long
With Sheets("Sheet43")
Last = .Range("A" & Rows.Count).End(xlUp).Row + 1
End With
Set Rng = Range(Range("D1"), Range("D" & Rows.Count).End(xlUp))
    For Each Dn In Rng
        If Dn.Value = "c" Then
            Dn.EntireRow.Copy Sheets("Sheet43").Cells(Last, "A")
        End If
Next Dn
End Sub

Regards Mick

 

[Mike Blackman]

Hi,

Of course, I have wrapped it all within a With Statement, just change the bold referenece to match your Sheet name;

Sub MoveRows()

Dim lRow As Long

With Sheets("Your Sheet")
    lRow = .Range("A" & Rows.count).End(xlUp).Row
    .Columns("D").AutoFilter Field:=1, Criteria1:="c"
    .Range("A1:E" & lRow).SpecialCells(xlCellTypeVisible).Copy Sheets(2).Range("A1")
    .ShowAllData
End With

End Sub

Hi Mick,

The Autofilter Method is in my opinion a lot lot more efficient than the loop.