Copy and paste row to new sheet based on cell value

[jjt1973]

I am trying to find a macro that will allow me to copy the contents of a row to another sheet2 based on a cell value in certain columns... Here is my example:

For this example I am looking to copy the row where the status (Column D) equals "Closed" to sheet2. I also need it to auto update as I enter in more rows of information.

Thank you in advance

 

[Jamie McMillan]

Hello,

The code bello will work.

NB activate it on Sheet1.

Sub CopyRowsToNewSheet()
Dim i As Integer
Dim j As Integer
    j = 1
    Application.ScreenUpdating = False
    Sheets("Sheet2").Range("A1:D22").ClearContents  'Clears Sheet2 Data
    For i = 1 To 22 '22 Number of rows to work through
    If Cells(i, 4).Value = "Closed" Then
    Cells(i, 4).Select
    Rows(ActiveCell.Row).Copy
    Sheets("Sheet2").Select
    Cells(j, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    j = j + 1
    Sheets("Sheet1").Select
    End If
    Next i
    Range("A1").Select
    Application.ScreenUpdating = True
    Range("A1").Select
End Sub

Jamie

 

[mumps]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your data sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter "Closed" in any row in column D and press the ENTER key.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 4 Then Exit Sub
    If Target = "Closed" Then
        With Sheets("Sheet2")
            Target.EntireRow.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    End If
    Application.ScreenUpdating = False
End Sub

 

[Joe4]

Hello,

The code bello will work.

NB activate it on Sheet1.

Sub CopyRowsToNewSheet()
Dim i As Integer
Dim j As Integer
    j = 1
    Application.ScreenUpdating = False
    Sheets("Sheet2").Range("A1:D22").ClearContents  'Clears Sheet2 Data
    For i = 1 To 22 '22 Number of rows to work through
    If Cells(i, 4).Value = "Closed" Then
    Cells(i, 4).Select
    Rows(ActiveCell.Row).Copy
    Sheets("Sheet2").Select
    Cells(j, 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    j = j + 1
    Sheets("Sheet1").Select
    End If
    Next i
    Range("A1").Select
    Application.ScreenUpdating = True
    Range("A1").Select
End Sub

Jamie

Just a little heads up (a tip on improving VBA code).
Having a lot of "Select" statements in your code can really slow it down (especially if inside of a loop!).
Usually, you don't need to select a range in order to work with it, and it is much faster to leave them out, whenever possible.

 

[jjt1973]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your data sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter "Closed" in any row in column D and press the ENTER key.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 4 Then Exit Sub
    If Target = "Closed" Then
        With Sheets("Sheet2")
            Target.EntireRow.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    End If
    Application.ScreenUpdating = False
End Sub

This worked great!! Thank you!

 

[mumps]

You are very welcome.

 

[jjt1973]

Copy and paste this macro into the worksheet code module. Do the following: right click the tab name for your data sheet and click 'View Code'. Paste the macro into the empty code window that opens up. Close the code window to return to your sheet. Enter "Closed" in any row in column D and press the ENTER key.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 4 Then Exit Sub
    If Target = "Closed" Then
        With Sheets("Sheet2")
            Target.EntireRow.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
        End With
    End If
    Application.ScreenUpdating = False
End Sub

If I wanted to alter the code so that if Column D reflected "Cancelled" that row would be copied to sheet 3.. Could I or would it be a whole different code? I ask because I tried adding an additional "If" statement using the same code and it didn't work.

 

[mumps]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 4 Then Exit Sub
    Select Case Target.Value
        Case "Closed"
            With Sheets("Sheet2")
                Target.EntireRow.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
            End With
        Case "Cancelled"
            With Sheets("Sheet3")
                Target.EntireRow.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
            End With
    End Select
    Application.ScreenUpdating = False
End Sub

 

[jjt1973]

Try:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column <> 4 Then Exit Sub
    Select Case Target.Value
        Case "Closed"
            With Sheets("Sheet2")
                Target.EntireRow.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
            End With
        Case "Cancelled"
            With Sheets("Sheet3")
                Target.EntireRow.Copy .Cells(.Rows.Count, "A").End(xlUp).Offset(1)
            End With
    End Select
    Application.ScreenUpdating = False
End Sub
[/QUOTE]


This worked great!! Thank you again!

 

[mumps]

My pleasure.