How to move entire row to another sheet based on cell value in Excel?

For moving entire row to another sheet based on cell value, this article will help you.

Move entire row to another sheet based on cell value with VBA code
Move entire row to another sheet based on cell value with Kutools for Excel


Move entire row to another sheet based on cell value with VBA code

As below screenshot shown, you need to move the entire row from Sheet1 to Sheet2 if a specific word “Done” exists in column C. You can try the following VBA code.

1. Press Alt+ F11 keys simultaneously to open the Microsoft Visual Basic for Applications window.

2. In the Microsoft Visual Basic for Applications window, click Insert > Module. Then copy and paste the below VBA code into the window.

VBA code 1: Move entire row to another sheet based on cell value

Sub Cheezy()
'Updated by Kutools for Excel 2017/8/28
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Done" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Note: In the code, Sheet1 is the worksheet contains the row you want to move. And Sheet2 is the destination worksheet where you will locate the row to. “C:C” is the column contains the certain value, and the word “Done” is the certain value you will move row based on. Please change them based on your needs.

3. Press the F5 key to run the code, then the row which meet the criteria in Sheet1 will be moved to Sheet2 immediately.

Note: The above VBA code will delete rows from the original data after moving to a specified worksheet. If you only want to copy rows based on cell value instead of deleting them. Please apply the below VBA code 2.

VBA code 2: Copy entire row to another sheet based on cell value

Sub MoveRowBasedOnCellValue()
'Updated by Extendoffice 2017/11/10
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Move entire row to another sheet based on cell value with Kutools for Excel

If you are newbie in VBA code. Here I introduce the Select Specific Cells utility of Kutools for Excel. With this utility, you can easily select all rows based on a certain cell value or different cell values in a worksheet, and the copy the selected rows to the destination worksheet as you need. Please do as follows.

Before applying Kutools for Excel, please download and install it firstly.

1. Select the column list contains the cell value you will move rows based on, then click Kutools > Select > Select Specific Cells. See screenshot:

2. In the opening Select Specific Cells dialog box, choose Entire row in the Selection type section, select Equals in the Specific type drop-down list, enter the cell value into the text box and then click the OK button.

Another Select Specific Cells dialog box pops up to show you number of selected rows, and meanwhile, all rows contain the specified value in selected column have been selected. See screenshot:

3. Press the Ctrl + C keys to copy the selected rows, and then paste them into the destination worksheet you need.

Note: If you want to move rows to another worksheet based on two different cell values. For example, move rows based on cell values either "Done" or "Processing", you can enable the Or condition in the Select Specific Cells dialog box as below screenshot shown:

  If you want to have a free trial ( 30-day) of this utility, please click to download it, and then go to apply the operation according above steps.


Related articles:


The Best Office Productivity Tools

Kutools for Excel Solves Most of Your Problems, and Increases Your Productivity by 80%

  • Reuse: Quickly insert complex formulas, charts and anything that you have used before; Encrypt Cells with password; Create Mailing List and send emails...
  • Super Formula Bar (easily edit multiple lines of text and formula); Reading Layout (easily read and edit large numbers of cells); Paste to Filtered Range...
  • Merge Cells/Rows/Columns without losing Data; Split Cells Content; Combine Duplicate Rows/Columns... Prevent Duplicate Cells; Compare Ranges...
  • Select Duplicate or Unique Rows; Select Blank Rows (all cells are empty); Super Find and Fuzzy Find in Many Workbooks; Random Select...
  • Exact Copy Multiple Cells without changing formula reference; Auto Create References to Multiple Sheets; Insert Bullets, Check Boxes and more...
  • Extract Text, Add Text, Remove by Position, Remove Space; Create and Print Paging Subtotals; Convert Between Cells Content and Comments...
  • Super Filter (save and apply filter schemes to other sheets); Advanced Sort by month/week/day, frequency and more; Special Filter by bold, italic...
  • Combine Workbooks and WorkSheets; Merge Tables based on key columns; Split Data into Multiple Sheets; Batch Convert xls, xlsx and PDF...
  • More than 300 powerful features. Supports Office/Excel 2007-2019 and 365. Supports all languages. Easy deploying in your enterprise or organization. Full features 30-day free trial. 60-day money back guarantee.
kte tab 201905

Office Tab Brings Tabbed interface to Office, and Make Your Work Much Easier

  • Enable tabbed editing and reading in Word, Excel, PowerPoint, Publisher, Access, Visio and Project.
  • Open and create multiple documents in new tabs of the same window, rather than in new windows.
  • Increases your productivity by 50%, and reduces hundreds of mouse clicks for you every day!
officetab bottom
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    bethrob1993 · 2 years ago
    Hi,

    I am using the macro that copies rows of data to another sheet. How might I get the macro to check multiple sheets - sheet 1, 2, 3 and so on, for the same information ("Done" in column G), and bring all relevant rows, across the sheets, to one sheet called "Reporting"?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Beth,
      Please try the below VA code. Hope it can help. Thank you.

      Sub MoveRowsToSheet()
      Dim xSh As Worksheet
      Dim xRg As Range
      Dim I, J, K As Long
      On Error Resume Next
      If Worksheets("Reporting") Is Nothing Then Exit Sub
      J = Worksheets("Reporting").UsedRange.Rows.Count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Reporting").UsedRange) = 0 Then J = 0
      End If
      I = xRgUsed(xRgUsed.Count).Row
      For Each xSh In Worksheets
      If xSh.Name <> "Reporting" Then
      Set xRg = xSh.UsedRange
      I = xRg(xRg.Count).Row
      Set xRg = Intersect(xRg, Range("G1:G" & I))
      If xRg Is Nothing Then GoTo Ctn
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      If CStr(xRg(K).Value) = "Done" Then
      xRg(K).EntireRow.Copy Destination:=Worksheets("Reporting").Range("A" & J + 1)
      xRg(K).EntireRow.Delete
      If CStr(xRg(K).Value) = "Done" Then
      K = K - 1
      End If
      J = J + 1
      End If
      Next

      End If
      Ctn:
      Next
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    bethrob1993 · 2 years ago
    Hi Crystal,

    The code has worked really well. How do I get the code to move a row of data, but only the data between columns A and J?

    I have another table at the side of these rows that I don't want it to move.

    Thanks
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Hi Beth,
      Please try the below VBA code. Hope it can help. Thank you.

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      I = Worksheets("Sheet1").UsedRange.Rows.Count
      J = Worksheets("Data").UsedRange.Rows.Count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Data").UsedRange) = 0 Then J = 0 'Data
      End If
      Set xRg = Worksheets("Sheet1").Range("K1:K" & I)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      Debug.Print CStr(xRg(K).Value)
      If InStr(1, CStr(xRg(K).Value), "Complete") > 0 Then
      Range("A" & xRg(K).Row & ":" & "J" & xRg(K).Row).Copy Destination:=Worksheets("Data").Range("A" & J + 1)
      xRg(K).EntireRow.Delete
      K = K - 1
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub

      Sub EnableEvents()
      Application.EnableEvents = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Hector · 2 years ago
    Hi Crystal,


    How do i Modify your code to add another layer to it. so say that if a cell has either "Done" or "Finished" in it, it should move the row. how do i add that modification?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Hector,
      The below VBA code can help you solve the problem, please have a try. Thank you.

      Sub MoveRowBasedOnCellValue()
      'Updated by Extendoffice 2018/5/22
      Dim xRg As Range
      Dim xCell As Range
      Dim xStr As String
      Dim I As Long
      Dim J As Long
      Dim K As Long
      I = Worksheets("Sheet1").UsedRange.Rows.Count
      J = Worksheets("Sheet2").UsedRange.Rows.Count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
      End If
      Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      xStr = CStr(xRg(K).Value)
      If xStr = "Done" Or xStr = "Finished" Then
      xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      xRg(K).EntireRow.Delete
      K = K - 1
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Brandon · 2 years ago
    I am using the code that moves the Row to another Tab and deletes the line. I am able to edit the code to work for my purpose, however I have a dropdown that contains 3 choices. Call them One, Two, and Three. If left blank, do nothing and leave the row alone. If dropdown choice One is selected, I am able to get that data moved to tab 1. I just need the additional code added to move Two to 2 and Three to 3. Please Help.
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Brandon,
      The following VBA code can help you to solve the problem. Please put the code into the worksheet (the sheet that contains the drop-down list) code window.

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim I As Long
      Dim xStr As String
      Application.EnableEvents = False
      If Target.Column = 3 And _
      Target.Validation.Type = 3 And _
      Target.CountLarge = 1 Then
      xStr = Target.Value
      xStr = IIf(xStr = "One", "1", IIf(xStr = "Two", "2", IIf(xStr = "Three", "3", "")))
      I = Worksheets(xStr).UsedRange.Rows.Count
      If I = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets(xStr).UsedRange) = 0 Then I = 0
      End If
      Rows(Target.Row).Copy Destination:=Worksheets(xStr).Range("A" & I + 1)
      Rows(Target.Row).Delete
      End If
      Application.EnableEvents = True
      End Sub

      If the above code doesn't work, please run the below code to enable the event. Hope it can help. Thank you.

      Sub EnableEvents()
      Application.EnableEvents = True
      End Sub
      • To post as a guest, your comment is unpublished.
        Brandon · 2 years ago
        Thanks so much for the reply but I had to remove this functionality. It started going wacky and pulling over data that wasn't supposed to be pulled. Thinking it might not like the conditional formatting I have programmed to change the cell color based on the selection, but I honestly don't know. The fact it's automatic concerns me in the sense I may click the incorrect value in the drop-down. I'd feel much better adding a buttons to do the exact same functionality as I requested above. Not sure how much of an undertaking that would be, but let me know if it's feasible.
  • To post as a guest, your comment is unpublished.
    Casandra · 2 years ago
    Can this same code be used to move the contents when a checkbox is checked instead of typing the word done?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Casandra,
      Supposing there are Check Boxes(ActiveX Control) in column C of your worksheet, and rows will be moved to Sheet6 when check box is checked. Please apply the below VBA code in your worksheet's code window. Hope it can help. Thank you.

      Function MoveRowBasedOnCheckBox()
      'Updated by Kutools for Excel 2018/5/21
      Cheezy = Worksheets("Sheet6").UsedRange.Rows.Count
      If Cheezy = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Sheet6").UsedRange) = 0 Then Cheezy = 0
      End If
      End Function
      Private Sub CheckBox1_Click()
      Dim I As Long
      Dim xRow As Long
      Dim xRg As Range
      On Error Resume Next
      If Me.CheckBox1 = True Then
      Set xRg = Me.CheckBox1.TopLeftCell
      If xRg.Column = 3 Then
      xRow = Me.CheckBox1.TopLeftCell.Row
      I = Cheezy
      Rows(xRow).Copy Destination:=Worksheets("Sheet6").Range("A" & I + 1)
      Rows(xRow).Delete
      OLEObjects("CheckBox1").Delete
      Call Add(Worksheets("Sheet6"), I + 1)
      End If
      End If
      End Sub
      Private Sub CheckBox2_Click()
      Dim I As Long
      Dim xRow As Long
      Dim xRg As Range
      On Error Resume Next
      If Me.CheckBox2 = True Then
      Set xRg = Me.CheckBox1.TopLeftCell
      If xRg.Column = 3 Then
      xRow = Me.CheckBox2.TopLeftCell.Row
      I = Cheezy
      Rows(xRow).Copy Destination:=Worksheets("Sheet6").Range("A" & I + 1)
      Rows(xRow).Delete
      OLEObjects("CheckBox2").Delete
      Call Add(Worksheets("Sheet6"), I + 1)
      End If
      End If
      End Sub
      'Copy above CheckBox code for other CheckBoxes
      Sub Add(xSheet As Worksheet, ByRef I As Long)
      Dim xRg As Range
      Set xRg = xSheet.Cells(I, 3)
      xSheet.OLEObjects.Add ClassType:="Forms.CheckBox.1", _
      Link:=False, DisplayAsIcon:=False, Left:=xRg.Left, Top:=xRg.Top, _
      Width:=xRg.Width, Height:=xRg.Height
      End Sub
  • To post as a guest, your comment is unpublished.
    julia · 2 years ago
    This is wonderful! Thank you!!

    I'm currently using the following VBA (I'm also new to this). 1-I want it to update automatically without manually having to press F5. 2- I ONLY want to copy cells A - J from the "Production Board" to the "Data" Sheet. 3- I want to delete the ENTIRE row from the "Production Board" once it has been copied over to the "Data" sheet

    Sub Cheezy()
    'Updated by Kutools for Excel 2017/8/28
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Production Board").UsedRange.Rows.Count
    J = Worksheets("Data").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Data").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Production Board").Range("K1:K" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
    If CStr(xRg(K).Value) = "Complete" Then
    xRg(K).EntireRow.Copy Destination:=Worksheets("Data").Range("A" & J + 1)
    xRg(K).EntireRow.Delete
    If CStr(xRg(K).Value) = "Complete" Then
    K = K - 1
    End If
    J = J + 1
    End If
    Next
    Application.ScreenUpdating = True
    End Sub
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Julia,
      Please try the following VBA code. Hope it can help. Thank you.

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      I = Worksheets("Production Board").UsedRange.Rows.Count 'Production Board
      J = Worksheets("Data").UsedRange.Rows.Count 'Data
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Data").UsedRange) = 0 Then J = 0 'Data
      End If
      Set xRg = Worksheets("Production Board").Range("K1:K" & I) 'Production Board
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      Debug.Print CStr(xRg(K).Value)
      If InStr(1, CStr(xRg(K).Value), "Complete") > 0 Then
      Range("A" & xRg(K).Row & ":" & "J" & xRg(K).Row).Copy Destination:=Worksheets("Data").Range("A" & J + 1)
      xRg(K).EntireRow.Delete
      K = K - 1
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub

      Sub EnableEvents()
      Application.EnableEvents = True
      End Sub
      • To post as a guest, your comment is unpublished.
        Kimberly · 2 years ago
        Hi Crystal,

        Is it possible to do this but with nonspecific sheet names? I tried to set the following but it didn't work. Thank you!
        Private Sub Worksheet_Change(ByVal Target As Range)
        Dim xRg As Range
        Dim xCell As Range
        Dim I As Long
        Dim J As Long
        Dim K As Long
        Dim sName As String
        Dim s2Name As String
        sName = Sheets(2).Name
        s2Name = Sheets(3).Name
        I = Worksheets("sName").UsedRange.Rows.Count 'sName
        J = Worksheets("s2Name").UsedRange.Rows.Count 's2Name
        If J = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("s2Name").UsedRange) = 0 Then J = 0 's2Name
        End If
        Set xRg = Worksheets("sName").Range("D1:D" & I) 'sName
        On Error Resume Next
        Application.ScreenUpdating = False
        For K = 1 To xRg.Count
        Debug.Print CStr(xRg(K).Value)
        If InStr(1, CStr(xRg(K).Value), "Proposal") > 0 Then
        Range("A" & xRg(K).Row & ":" & "J" & xRg(K).Row).Copy Destination:=Worksheets("s2Name").Range("A" & J + 1)
        xRg(K).EntireRow.Delete
        K = K - 1
        J = J + 1
        End If
        Next
        Application.ScreenUpdating = True
        End Sub

        Sub EnableEvents()
        Application.EnableEvents = True
        End Sub
  • To post as a guest, your comment is unpublished.
    Wendy0128 · 2 years ago
    This is fantastic but how can I combine them (from how similar they it appears it can be done, I just can't get it spliced in right to make it work)? What I am trying to do is when the word is "Sold" it moves the row but when the word is "Partial" it copies the row (words are both in the same column). Thanks for your help.
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Wendy,
      Supposing rows will be moved or copied from Sheet1 to Sheet2 based on specified values, the following VBA code can help you solve the problem. Thank you for your comment.

      Sub MoveRowBasedOnCellValue()
      'Updated by Extendoffice 2018/05/21
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      I = Worksheets("Sheet1").UsedRange.Rows.Count
      J = Worksheets("Sheet2").UsedRange.Rows.Count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
      End If
      Set xRg = Worksheets("Sheet1").Range("E1:E" & I)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      If CStr(xRg(K).Value) = "Sold" Then
      xRg(K).EntireRow.Cut Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      xRg(K).EntireRow.Delete
      K = K - 1
      J = J + 1
      ElseIf CStr(xRg(K).Value) = "Partial" Then
      xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Shane · 2 years ago
    I can't get it to work. At all. Nothing happens. The screen flashes once real quick like something did happen, but when I go to the tab the lines were supposed to be copied to, it's still blank. Here are the differences between what I have and your example:
    1. First 2 rows are freeze-paned.
    2. I need all this to start on row for on source sheet, and row 4 on destination sheet - They both have the first 2 rows freeze-paned (for titles).
    I need it copied and not moved, so I used your second example, and made my modifications.

    Here is what I'm using:

    Sub WEST()
    'Updated by Kutools for Excel 2017/8/28
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Mar 18 CIA").UsedRange.Rows.Count
    J = Worksheets("West").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("West").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Mar 18 CIA").Range("E4:E" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
    If CStr(xRg(K).Value) = "West" Then
    xRg(K).EntireRow.Copy Destination:=Worksheets("West").Range("A" & J + 1)
    J = J + 1
    End If
    Next
    Application.ScreenUpdating = True
    End Sub
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Good day,
      Your code works well. Please check if case sensitive exist between cells in column E and the specified word "West". Thank you.
  • To post as a guest, your comment is unpublished.
    abrah336@d.umn.edu · 2 years ago
    Thanks Crystal, this code was working great for me last week but it seems to be giving me issues this week. I have multiple items that update to a "completed" status when I open the workbook and all of these items should be moving but instead the code seems to error out.... I just get the blue spinning circle and excel eventually stops responding. Is there something I need to do to the code so that it can handle multiple rows at the same time?


    Sub Complete()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("New-Open EFR'S").UsedRange.Rows.Count
    J = Worksheets("Completed EFR's").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Completed EFR's").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("New-Open EFR'S").Range("O1:O" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
    If CStr(xRg(K).Value) = "Complete" Then
    xRg(K).EntireRow.Copy Destination:=Worksheets("Completed EFR's").Range("A" & J + 1)
    xRg(K).EntireRow.Delete
    If CStr(xRg(K).Value) = "Complete" Then
    K = K - 1
    End If
    J = J + 1
    End If
    Next
    Application.ScreenUpdating = True
    End Sub
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Good Day,
      Please change the first line in the code to "Private Sub Worksheet_Change(ByVal Target As Range)", and change "Complete" to "Completed". See code below:

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      I = Worksheets("New-Open EFR'S").UsedRange.Rows.Count
      J = Worksheets("Completed EFR's").UsedRange.Rows.Count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Completed EFR's").UsedRange) = 0 Then J = 0
      End If
      Set xRg = Worksheets("New-Open EFR'S").Range("O1:O" & I)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      If CStr(xRg(K).Value) = "Completed" Then
      xRg(K).EntireRow.Copy Destination:=Worksheets("Completed EFR's").Range("A" & J + 1)
      xRg(K).EntireRow.Delete
      If CStr(xRg(K).Value) = "Complete" Then
      K = K - 1
      End If
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    SabinaM · 2 years ago
    Hi Crystal,

    Thank you very much for all your help with my spreadsheet.

    Could you please advice if i should remove conditional formatting from the spreadsheet to make the automated VBA code work and do not freeze the entire file.

    Thank you,

    Sabina
  • To post as a guest, your comment is unpublished.
    renaissancehero@gmail.com · 2 years ago
    Hi There,

    Thank you for such a great post and your very helpful counsel to everyone...
    How can I have the copied rows from Sheet1 always write on the 2nd row of Sheet2 over writing all the previous copies. Also, is there a way to have the search look for contents. Like Completed March 10th, 2018 by Eric. Search "*Completed*" . As of right now, the code has to be an exact match and I would like it to be search just one word.

    Will that work?
    Thank you for your time and your response in advance.

    Regards,
    HERO
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Good Day,
      The below VBA code can help you solve the problem.

      Sub MoveRowBasedOnCellValue()
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      I = Worksheets("Sheet1").UsedRange.Rows.Count
      J = 1
      Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      If InStr(CStr(xRg(K).Value), "Completed") > 0 Then
      xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    ashleybv67@gmail.com · 2 years ago
    Hello,


    I continue to get "Compile error: Syntax error on this


    xRg(K).EntireRow.Copy Destination:=Worksheets("Complete
    ").Range("A" & J + 1)





    What am I doing wrong?


    My tab names are Incomplete and Complete
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Good Day,
      Have you replaced all "Sheet2" in above code with your sheet name "Complete"?
      Would be nice if you can send me your workbook via zxm@addin99.com.

      Thank you for you comment.
  • To post as a guest, your comment is unpublished.
    hdavis2189@gmail.com · 2 years ago
    Hello,

    Thank you for sharing this code, it has proven to be very helpful! I have ran into a bit of a snag, though.

    My issue is that the cells I want to check the value could change columns. In your example you have 3 columns - Name, Team Color, Finish or not - and you want to check "Finish or Not" which is in column C.

    Is there a way to make this code dynamic so that if the "Finish or Not" was to move to column F it would search and copy the correct data?

    Set xRg = Worksheets("Sheet1").Range("C1:C" & I) Set xRg = Worksheets("Sheet1").Range(????)
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Hank Davis,
      Please change the code Set xRg = Worksheets("Sheet1").Range("C1:C" & I) to
      Set xRg = Worksheets("Sheet1").Range("C:F").
      Thank you for your comment.
      • To post as a guest, your comment is unpublished.
        ttacco22@gmail.com · 2 years ago
        Hello I have in the past used VBA to do certain things in Office and have forgotten more than I remember. That being said, I am using Microsoft Window 7 Home Premium with an older version of Microsoft Office (am thinking 2003).
        I have a spreadsheet I am using to track my media collection of mp4s and such. By using a dir command in Command box to output a txt file that I parse to render cells with path to the media (mainly mp4s) and the actual filename.mp4.
        What I am trying to accomplish is to move every row with a cell with a filename.mp4 to another sheet.
        This is my code thus far:
        Sub MoveMp4()
        'Private Sub Worksheet_Change(ByVal Target As Range) [[use this as top line to run automatically if desired]]
        Dim xRg As Range
        Dim xCell As Range
        Dim I As Long
        Dim J As Long
        Dim K As Long
        I = Worksheets("Sheet1").UsedRange.Rows.Count
        J = Worksheets("Sheet2").UsedRange.Rows.Count
        If J = 1 Then
        If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
        End If
        'Set xRg = Worksheets("Sheet1").Range("C1:C" & I) 'This would never work for me as C is too low HAS TO BE E THRU I AS IN THE BELOW
        Set xRg = Worksheets("Sheet1").Range("E:I") '[[ADDED THIS AS THE RANGE CHANGES
        DYNAMICALLY]]
        On Error Resume Next
        Application.ScreenUpdating = False
        For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = ".mp4" Then
        xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
        xRg(K).EntireRow.Delete
        If CStr(xRg(K).Value) = ".mp4" Then
        K = K - 1
        End If
        J = J + 1
        End If
        Next
        Application.ScreenUpdating = True
        End Sub
        Again, this code works if a single cell in range E:I contains .mp4 yet will not move the row if there are characters before the .mp4 (as most filenames would be) and thus my use of filename.mp4 in description above.
        Apologies for the length of the post yet I wanted to be clear as to what I desire as opposed to going back and forth with explainations.
        And finally I should like to add that, you people are doing a great service to the community of the world, Thank You from the bottom of my heart soul and mind!
        • To post as a guest, your comment is unpublished.
          crystal · 2 years ago
          Dear Anthony Tacco,
          Do you mean moving row based on content ".mp4" in certain column even there are characters before or after the .mp4?
          Do you mind sending your workbook to me via zxm@addin99.com?
          • To post as a guest, your comment is unpublished.
            ttacco22@gmail.com · 2 years ago
            Last Friday (03-30-18). I replied to an email with regard to your response to my post, with workbook and related data. I just forwarded it the email address listed here (zxm@addin99.com). Please let me know if anyone has received it. Thank You
  • To post as a guest, your comment is unpublished.
    Hank · 2 years ago
    Hello,

    Thank you for sharing this code, it has proven to be very helpful! I have ran into a bit of a snag, though.

    My issue is that the cells I want to check the value could change columns. In your example you have 3 columns - Name, Team Color, Finish or not - and you want to check "Finish or Not" which is in column C.

    Is there a way to make this code dynamic so that if the "Finish or Not" was to move to column F it would search and copy the correct data?

    Set xRg = Worksheets("Sheet1").Range("C1:C" & I) -> Set xRg = Worksheets("Sheet1").Range(????)
  • To post as a guest, your comment is unpublished.
    refad0312@gmail.com · 2 years ago
    hello,
    can u help me ??
  • To post as a guest, your comment is unpublished.
    SabinaM · 2 years ago
    Hello.


    Your chat was a great help and exactly what i was looking for. VBA code work perfectly, however, i can not make work automation VBA code you have responded with to billy 2 months ago. Should i add it to the original one or keep separate? Also is it possible to make moved raw keep format?
    i am totally new in VBA and would appreciate your help.

    Thank you,

    Sabina
  • To post as a guest, your comment is unpublished.
    Sabina · 2 years ago
    Hello.


    Your chat was a great help and exactly what i was looking for. VBA code work perfectly, however, i can not make work automation VBA code you have responded with to billy 2 months ago. Should i add it to the original one or keep separate? Also is it possible to make moved raw keep format?
    i am totally new in VBA and would appreciate your help.

    Thank you,

    Sabina
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Sabina,
      You need to put the code into another code window. And the cell format will be kept when moving.
      Please open the Sheet1 code window instead of the Module window, and the copy the below VBA code into the window.

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      On Error Resume Next
      Application.ScreenUpdating = False
      If Target.Count = 1 And Intersect(Target, Columns(3)) Then
      I = ActiveSheet.UsedRange.Rows.Count
      J = Worksheets("Sheet2").UsedRange.Rows.Count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
      End If
      If Target.Value = "Done" Then
      Target.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      Target.EntireRow.Delete
      End If
      End If
      Application.ScreenUpdating = True
      End Sub
      • To post as a guest, your comment is unpublished.
        SabinaM · 2 years ago
        Dear Crystal,

        Just found out that it glitches with all conditional formatting and auto-formatted table. Manual VBA code works well though. any advises on that?
      • To post as a guest, your comment is unpublished.
        SabinaM · 2 years ago
        Dear Crystal,


        I have found it, please ignore my previous message. - Works amazing. THANK YOU.
      • To post as a guest, your comment is unpublished.
        SabinaM · 2 years ago
        Dear Crystal,
        Thank you very much for your help with VBA code for formatting and automation. Appreciate your time. Feeling bad to ask, but could you please advice where to find "Sheet1 code window". Perhaps its a silly question, but its my second time opening VBA. Thank you. S
        • To post as a guest, your comment is unpublished.
          crystal · 2 years ago
          Dear Sabina,
          Please open the Microsoft Visual Basic for Applications window by pressing the Alt + F11 keys, and then double click Sheet1 in the left VBAProject pane to open the Sheet1 Code window as below screenshot shown. Hope I can help. Thank you.
          • To post as a guest, your comment is unpublished.
            SabinaM · 2 years ago
            Dear Crystal,
            Thank you very much, indeed. I know where to find it now and your VBA code worked, although i have few conditional formats and entire table is auto-formated and when i pull them down to copy all file glitches. But original VBA codes works with no problems.Thank you S.
  • To post as a guest, your comment is unpublished.
    Jay P · 2 years ago
    Thanks for this, works great! How do I make VBA Code 2 automatic instead of hitting F5 every time?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Good Day,
      Copy the VBA code 2 into the Sheet1 code window instead of the Module window, then replace the first line of the code with: Private Sub Worksheet_Change(ByVal Target As Range)
  • To post as a guest, your comment is unpublished.
    bourgoin.rene@yahoo.ca · 2 years ago
    I Really Like the code and it works really good. I am using the first one that moves to the second sheet and delete the entire row of the source. How can I modify it a little so it only moves the values between columns C:J of that row to the second sheet. Then do a clear content between C:J of that row as well. Sorry I am new to vba and I tried a few things and failed :-(


    Any help will be very appreciated
    thanks in advance.
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Rene,
      The below VBA code can help you solve the problem. Thank you for your comment.

      Sub Cheezy()
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      I = Worksheets("Sheet1").UsedRange.Rows.Count
      J = Worksheets("Sheet2").UsedRange.Rows.Count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
      End If
      Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      If CStr(xRg(K).Value) = "Done" Then
      Debug.Print xRg(K).Resize(1, 8).Address
      xRg(K).Resize(1, 8).Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      xRg(K).Resize(1, 8).Clear
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub
      • To post as a guest, your comment is unpublished.
        Britney · 2 years ago
        I'm not sure what I'm doing wrong. I didn't want to ask the same question other people have asked, but I couldn't find my answer in the comments, so here it is.

        I used the VBA code 2 from the original article to copy the information from sheet1 to sheet2. I only want to copy the information in Columns A:G. After reading this code, I changed the original line of code: "xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)" to the two lines "Debug.Print xRg(K).Resize(1, 7).Address
        xRg(K).Resize(1, 7).Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)". After running the code, nothing populates. I'm not sure what I'm doing wrong. Please help!
  • To post as a guest, your comment is unpublished.
    SHER · 2 years ago
    IF I WANT TO MOVE THE ROW TO THE BOTTOM OF ANOTHER SHEETS DATA HOW DO I DO THAT?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear SHER,
      If data already exists in the destination worksheet, after running the code, the row will be moved to the bottom of the original data automatically.
  • To post as a guest, your comment is unpublished.
    Bre · 2 years ago
    Crystal- disregard previous question. I got that part figured out. However, my issue is that if row 27 column F gets changed to Paid than everything under it (rows 28-41) get moved over to the spreadsheet as well even though those are still in "sent" status.
  • To post as a guest, your comment is unpublished.
    Andy · 2 years ago
    The VBA code 1 listed above works great, how do I make it automatic when the data is entered instead of having to open the editor and hitting F5?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Good Day,
      The below VBA code can help you.

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      On Error Resume Next
      Application.ScreenUpdating = False
      If Target.Count = 1 And Intersect(Target, Columns(3)) Then
      I = ActiveSheet.UsedRange.Rows.Count
      J = Worksheets("Sheet2").UsedRange.Rows.Count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
      End If
      If Target.Value = "Done" Then
      Target.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      Target.EntireRow.Delete
      End If
      End If
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Kristin Margerison · 2 years ago
    Hi there,
    Thanks so much for this! It is very cool.
    I am trying to apply this to a spreadsheet where I want to move a row if a date field is populated (with any date). Is there a way to move the row if the field "is not null"?
    Hopefully this can be done!
  • To post as a guest, your comment is unpublished.
    DanJ98 · 2 years ago
    Hi, brilliant macro. Is it possible to paste these rows in the format 'paste special - value only' and can you control the point at which the first row is pasted? Finally (I'm new to VBA so apologies) is this possible to put into a button function?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Daniel,
      Please insert the below VBA code into your workbook Module firstly. Insert a button into the worksheet contains the rows you will copy (in this case it is Sheet1) and assign the Macro named "CopyRows" to that button. Thank you.

      Sub CopyRows()
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      I = Worksheets("Sheet1").UsedRange.Rows.Count
      J = Worksheets("Sheet2").UsedRange.Rows.Count
      Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 1
      xRg(1).EntireRow.Copy
      Worksheets("Sheet2").Range("A" & J).PasteSpecial xlPasteValues
      End If
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      If CStr(xRg(K).Value) = "Done" Then
      xRg(K).EntireRow.Copy
      Worksheets("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteValues
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Cloud343 · 2 years ago
    Hello,

    I am totally new to any form of code, I am sat in the office at 02:41am and am trying to build a massive excel doc as a backend to a very rudimentary "database" if I can call it that :). I have so far managed to link all target pages back to the master file and all the variable cells back to a master data consolidation file so that I can update all sheets and all dropdowns at once, with IF and COUNT, paste link and data consolidation commands only, given I have only really been using excel since Saturday I'm fairly happy with that.


    However what I am struggling with it I cannot for the life of me get a row to go from active sheet to target sheet on another workbook based on cell value being "sold". I REALLY need some help with this, what I want is possible and it's driving me nuts, if I could understand why the macro above is the way it is I might be able to figure out where I am going wrong.


    Can someone please literally spell it out to me?? I need cell Q2:Q1000 If "sold" to move from (Dan Parker workbook) tab (Dan Parker JC) to copy entire row to work book (Sales and Appointments) tab (Sales) and find the next available row to enter the data, if possible clearing the clipboard once the operation is complete and returning to cell A1 on the active tab?


    The workbooks are both saved on the same shared drive and both are password protected - does this require additional coding to enter password - or will it work regardless?


    Any and all help would be greatly appreciated, and if you could explain the commands in your post, what each line actually is doing I would be over the moon!!!! If I can get this to work once I need to reapply it to about 44 other tabs and change the source tab in the same workbook but the target file stays the same.


    First timer in need of help, thanking you in advance.


    Regards

    Kyle
  • To post as a guest, your comment is unpublished.
    Vikram · 2 years ago
    Hello,


    the code works beautifully, thank you. I have a column with a dropdown and every time i change the value to a specific one(LIVE), it gets moved over to the second sheet.


    However, if i select LIVE by mistake, i need the system to automatically remove the copied column from the target worksheet if i change the value again. How can this be done?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Vikram,
      This operation can't be done. Sorry about that.
  • To post as a guest, your comment is unpublished.
    Toon · 2 years ago
    Hello,

    Thanks for the VBA code, works perfect. Although I would like to know how I can copy multiple values. For example: I would like to cope every row with students that are born before 1990. So the value "Done" should be all the years before 1990. How do I apply this in te code?


    Thanks for the help!
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Toon,
      Replace the = "Done" in this code line "If CStr(xRg(K).Value) = "Done" Then" with < 1990 can help you solve the problem.
      And your code line should be "If CStr(xRg(K).Value) < 1990 Then"

      Thank you!
  • To post as a guest, your comment is unpublished.
    equipaeartes@gmail.com · 2 years ago
    Hello,


    I have a workflow chart excel sheet in google docs and i edit everything online. I don't have excel installed. I have some Conditioning formating and Data Validation formulas already but i wanted a new one. Dunno if this is possible with only Conditional formating or Data Validation.

    I wanted that, if Column K had specific text = "No", then Move entire row up ( without replacing existing one of course). I wanted that so i could, move up the rows on the sheet, tasks that aren't done already and "push" the tasks that are done bottom. I already have a conditional format for "yes" and "no" for row colour, but that isn't enough
    Any ideas would be highly appreciated.


    Thank you
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Good Day,
      We haven't tested in Google sheet, sorry can't help you.
  • To post as a guest, your comment is unpublished.
    billy · 2 years ago
    The only way it runs for me is if I open the VBA editor and manually run it which is not very useful. Is there a way for the code to run automatically once I change the change the value of the cell to Done? Thanks
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Good Day,
      The below VBA code can help you.

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      On Error Resume Next
      Application.ScreenUpdating = False
      If Target.Count = 1 And Intersect(Target, Columns(3)) Then
      I = ActiveSheet.UsedRange.Rows.Count
      J = Worksheets("Sheet2").UsedRange.Rows.Count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
      End If
      If Target.Value = "Done" Then
      Target.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      Target.EntireRow.Delete
      End If
      End If
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    ashley · 2 years ago
    That worked really well, however, it does not refresh automatically, i need to open the code and push F5 every time, how to i get it to change automatically?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Good Day,
      The below VBA code can help you.

      Private Sub Worksheet_Change(ByVal Target As Range)
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      On Error Resume Next
      Application.ScreenUpdating = False
      If Target.Count = 1 And Intersect(Target, Columns(3)) Then
      I = ActiveSheet.UsedRange.Rows.Count
      J = Worksheets("Sheet2").UsedRange.Rows.Count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
      End If
      If Target.Value = "Done" Then
      Target.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      Target.EntireRow.Delete
      End If
      End If
      Application.ScreenUpdating = True
      End Sub
      • To post as a guest, your comment is unpublished.
        Angela · 2 years ago
        hello, I am SO new at this and see that this VBA code can make the process automatic, but I put this as a separate module from VBA code 1 or as an addition on top or bottom of the original module?
        • To post as a guest, your comment is unpublished.
          crystal · 2 years ago
          Dear Angela,
          You need to put this code into the Sheet1 code window (the worksheet contains the rows you will move).
          In the Microsoft Visual Basic for Applications window, please double click Sheet1 in the left pane to open its code window.
      • To post as a guest, your comment is unpublished.
        Bre · 2 years ago
        Hey Crystal!
        I got this to work but my question is when it moves the information over to the tab it pastes it at the bottom of the sheet. specifically line 385. I only have 40 lines of data on that spreadsheet. anyway to get it to paste at the bottom of the data instead of spreadsheet?
  • To post as a guest, your comment is unpublished.
    Kat Williams · 2 years ago
    Wow! That worked like a charm! Thank you so much.
  • To post as a guest, your comment is unpublished.
    John Carlo · 2 years ago
    Hi,

    I'm new to using macros, is it possible to paste the data below after a certain value and will be repeated until end of column?
    Like this:

    Transfer "Blue" after "Color"

    A1 = Blue
    A5= Color
    A6= (transfer "Blue" here)
    and so on...
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear John,
      Do you mean if a cell contains "Color" in a column, then copy text of the first cell to the cell below the "Color" one and repeat copy this text until end of the column?
  • To post as a guest, your comment is unpublished.
    mpreston617@gmail.com · 2 years ago
    Hello,


    I know this has been posted a few times but I can't find the answer. How can I copy the material to the new sheet and NOT delete it from the original sheet?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Mike,
      If you want to copy the rows instead of deleting them, the below VBA code can help you. Thank you for your comment!

      Sub Cheezy()
      Dim xRg As Range
      Dim xCell As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      I = Worksheets("Sheet1").UsedRange.Rows.Count
      J = Worksheets("Sheet2").UsedRange.Rows.Count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
      End If
      Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      If CStr(xRg(K).Value) = "Done" Then
      xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Mike · 2 years ago
    Hello,


    How do I copy the rows instead of moving them?
  • To post as a guest, your comment is unpublished.
    HLB · 2 years ago
    Hi,

    I would like to have this macro set up but with 2 arguments. I managed to get the macro working in my file based on the value of the cells in column O. However I would like for the Macro to check if Column S is filled out (or <> "") as well, before moving the row. Lastly, I would also like to have the copied rows be the same formatting as the rows in the second sheet. Does that change completely the macro?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Hugues,
      I do not know if I understand you the right way. You mean that if cell in column S is filled out and cell in Column O contains the certain value at the same time, then move the row with formatting? Otherwise, don't move?
      • To post as a guest, your comment is unpublished.
        Hugues · 2 years ago
        Hello Crystal,

        Yes that is exactly what I mean. In fact, my data is about projects. My column O is the status of my project, and S the end date of my project.
        I want my users, the people that have the information and will need to insert it, to be able to "Archive" a project ONLY if they have their status as "Closed" and they have inserted an "End date".


        I hope this helps clarify things
        • To post as a guest, your comment is unpublished.
          crystal · 2 years ago
          Dear Hugues,
          Sorry for replying so late. The following VBA code can help you solve the problem. Please follow the steps in this article to apply the VBA script.

          Sub MoveRowBasedOnCellValue()
          Dim xRgStatus As Range
          Dim xRgDate As Range
          Dim I As Long
          Dim J As Long
          Dim K As Long
          I = Worksheets("Sheet1").UsedRange.Rows.Count
          J = Worksheets("Sheet2").UsedRange.Rows.Count
          If J = 1 Then
          If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
          End If
          Set xRgStatus = Worksheets("Sheet1").Range("O1:O" & I)
          Set xRgDate = Worksheets("Sheet1").Range("S1:S" & I)
          On Error Resume Next
          Application.ScreenUpdating = False
          Application.CutCopyMode = False
          xRgStatus(1).EntireRow.Copy
          Worksheets("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
          J = J + 1
          For K = 2 To xRgStatus.Count
          If CStr(xRgStatus(K).Value) = "Closed" Then
          If (xRgDate(K).Value <> "") And (TypeName(xRgDate(K).Value) = "Date") Then
          xRgStatus(K).EntireRow.Copy
          Worksheets("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteAllUsingSourceTheme
          J = J + 1
          End If
          End If
          Next
          Application.CutCopyMode = True
          Application.ScreenUpdating = True
          End Sub
          • To post as a guest, your comment is unpublished.
            Hugues · 2 years ago
            Dear Crystal,

            Thank you so much for your help!

            Regards,

            Hugues
  • To post as a guest, your comment is unpublished.
    janang · 2 years ago
    thanks for this formula, but I had a problem which is when I want to move the row to another sheet, it doesn't happen automatically. can you give me another formula ? so whenever I change the value of the cell's, it moved automatic.


    thanks
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear janang,
      The code dose not happen automatically until you trigger the run button manually.
  • To post as a guest, your comment is unpublished.
    mghodsi · 2 years ago
    I would like help for a similar task, but slightly different. I have 5 columns of numbers, around 25000 per column, each column with a heading 1-5.I would like to copy the entire row to another sheet if the value of column 1 is great than zero, OR column 2 is greater than zero, OR column 3 is less than zero, OR column 4 is great than five OR column 5 is greater than two etc. is this possible ?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Michael,
      Maybe you can solve this probem by using an Excel add-in. Here i recommend you the Select Specific Cells utility of Kutools for Excel. With this utility, you can easily select all rows in a certian range if the value of a specified column is greater than or less than a number. After selecting all needed rows, you can manually copy and paste them to a new worksheet. See below attached image.

      You can know more about this feature by following the below hyperlink.
      https://www.extendoffice.com/product/kutools-for-excel/excel-select-specific-cells-rows.html
    • To post as a guest, your comment is unpublished.
      mghodsi · 2 years ago
      image upload not working... sorry.
      • To post as a guest, your comment is unpublished.
        qiuhongkun · 2 years ago
        Hello,
        Please use the upload button of this one.
        • To post as a guest, your comment is unpublished.
          mghodsi · 2 years ago
          Image attached
        • To post as a guest, your comment is unpublished.
          mghodsi · 2 years ago
          So the aim is to see if any of the gasses are over a limit which i will set in the formula, the entire roe is COPIED onto a new sheet.

          Thank you so much for any help.
  • To post as a guest, your comment is unpublished.
    dr.kylie.g.cole@gmail.com · 2 years ago
    Could someone help me make this work? I've tried to change the part that need to match up with my file, but this comes up and I'm not sure what to do.
    • To post as a guest, your comment is unpublished.
      dr.kylie.g.cole@gmail.com · 2 years ago
      it says file not supported when I try to upload the excel file. Sorry...struggling with this today.
  • To post as a guest, your comment is unpublished.
    Shai Alon · 2 years ago
    There is a big error in your script!

    Say that you detected that row 7 has the word "Done" in column C, so you copy it and delete the row.
    Once you deleted the row, the next row in the list will be row 9 and not 8, because once you removed the 7th line, now the 8th line content is in line 7, and all the lines went up 1 row. So the next row to check was supposed to be row #8, but now it contains the data that previously was on row #9, so every time you are deleting a row, you are actually skipping a row to check!!!
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Shau Alon,

      Thank you for your comment. The code has been updated with the error fixed. Thank you so much for your assistant.

      Best Regards, Crystal
  • To post as a guest, your comment is unpublished.
    David · 2 years ago
    I am running this code and am trying to move a row based on today's date appearing in column I - I have changed Range("B1:B" & I) to read Range(I1:I" & I) . I have changed "Done" in your example to Date. However, when today's date appears anywhere in the row, not just in the I column as required, the row moves to the alternate worksheet. Any idea why this is happening and how I can have the row move only when today's date is in column I, regardless of whether today's date appears in other columns?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear David,

      The code works well for me after changing the range and the variate value to date. The date format in your code must match the date format you used in worksheet. Or is it convenient for you to attach your worksheet?
      • To post as a guest, your comment is unpublished.
        davidv@brc2.com · 2 years ago
        Hi Crystal,


        I am not clear what you mean when you say that the code and spreadsheet date formats must match - I am not a VB expert, more a novice level. In my spreadsheet I enter today's date in column F as the entry date of the row, in the format ctrl + :. I enter the expiration date in column "I" in the mm/dd/yyyy format. However, this causes problems when making a new row entry and entering today's date in column F because, as soon as it is entered, the row is moved to the new worksheet.Additionally the additional code to run whenever the workbook is opened does not appear to run without me forcing it to do so. Sorry for what might be to you very trivial issues but I just can't get my hear around these issues. Any help would be appreciated.
        • To post as a guest, your comment is unpublished.
          crystal · 2 years ago
          Dear David,

          I have tried as exactly what you mentioned above, but the issue dose not appear in my case. Can you provide your Excel version? I need more information to help solving this problem. Sorry to trouble you again.

          Best Regards, Crystal
          • To post as a guest, your comment is unpublished.
            davidv@brc2.com · 2 years ago
            Crystal, these are the worksheets concerned. You will see in the copied code that I am searching for "up to " today's date in column L and if "up to" and including today's date is in that column then I want to move the row containing that date to a new worksheet. Currently, when I enter today's date anywhere in the row(for example column F if a solicitation is issued today) it automatically moves the entire row to the archived spreadsheet. I usually enter today's date by using the ctrl + : combination, usually in column F.
            Additionally I would like this move to happen when I open the workbook. Currently I need to go to show code then press F5. Any advice on how to do that would be welcomed.
            • To post as a guest, your comment is unpublished.
              davidv@brc2.com · 2 years ago
              Crystal,

              As I can't upload my workbook I will reproduce the rows & columns here

              A B C D E F G H I J K L
              # Type Set-Aside Solicitation Amend # Issue Date Questions Customer Delivery Location Project Proposal Due

              1 SS SB 1234567 1 09/6/17 No Army Name Place Drive Tank 09/10/17

              Using the code below, I want it to move an entire row to a new worksheet when column L reaches today's date. Also if I have not completed the worksheet for a number of days I would like it to use "up to today's date" search in column L to do the same. I would also like it to do this automatically when I open the workbook if possible. Currently if I enter today's date in any cell in the row, for example column F when entering data, the entire row moves to the archive worksheet. (Using Excel 2016)

              [Module 1 Code]

              Sub DaveV()

              Dim xRg As Range

              Dim xCell As Range

              Dim I As Long

              Dim J As Long

              I = Worksheets("CURRENT OASIS OPPORTUNITIES").UsedRange.Rows.Count

              J = Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange.Rows.Count

              If J = 1 Then
              If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Then J = 0

              End If

              Set xRg = Worksheets("CURRENT OASIS OPPORTUNITIES").Range("L1:L" & I)

              On Error Resume Next

              Application.ScreenUpdating = False

              For Each xCell In xRg

              If CStr(xCell.Value) = Date Then

              xCell.EntireRow.Copy Destination:=Worksheets("ARCHIVED OASIS OPPORTUNITIES").Range("A" & J + 1)
              xCell.EntireRow.Delete

              J = J + 1
              End If

              Next
              Application.ScreenUpdating = True

              End Sub
              • To post as a guest, your comment is unpublished.
                davidv@brc2.com · 2 years ago
                [Sheet 1 Code]

                Private Sub Worksheet_Change(ByVal Target As Range)
                Dim xCell As Range
                Dim I As Long
                On Error Resume Next
                Application.ScreenUpdating = False
                Set xCell = Target(1)
                If xCell.Value = Date Then
                I = Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange.Rows.Count
                If I = 1 Then
                If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Then I = 0 End If
                xCell.EntireRow.Copy Worksheets("ARCHIVED OASIS OPPORTUNITIES").Range("A" & I + 1)
                xCell.EntireRow.Delete
                End If
                Application.ScreenUpdating = True
                End Sub

                Hope the above helps but I am not a VBA person therefore do not understand how to make the code do what I need. Your help would be appreciated.
            • To post as a guest, your comment is unpublished.
              davidv@brc2.com · 2 years ago
              Unfortunately my macro enabled workbook will not upload as it says format not supported. These are in Excel 2016
              • To post as a guest, your comment is unpublished.
                crystal · 2 years ago
                Dear David,

                The following VBA code can help you to achieve it.

                Private Sub Workbook_Open()
                Dim xRg As Range
                Dim xCell As Range
                Dim I As Long
                Dim J As Long
                I = Worksheets("CURRENT OASIS OPPORTUNITIES").UsedRange.Rows.Count
                J = Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange.Rows.Count
                If J = 1 Then
                If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Then J = 0
                End If
                Set xRg = Worksheets("CURRENT OASIS OPPORTUNITIES").Range("L1:L" & I)
                On Error Resume Next
                Application.ScreenUpdating = False
                For Each xCell In xRg
                If CStr(xCell.Value) = Date Then
                xCell.EntireRow.Copy Destination:=Worksheets("ARCHIVED OASIS OPPORTUNITIES").Range("A" & J + 1)
                xCell.EntireRow.Delete
                J = J + 1
                End If
                Next
                End Sub

                Notes:
                1. You need to put the VBA script into the ThisWorkbook code window;
                2. Your workbook need to be saved as Excel Macro-Enabled Workbook.

                After the above operartion, every time when you open the workbook, an entire row will be moved to ARCHIVED worksheet if cell in column L reaches today's date.

                Beast Regards, Crystal
                • To post as a guest, your comment is unpublished.
                  davidv@brc2.com · 2 years ago
                  Thanks Crystal,
                  This works great if today's date is achieved in the column L. Is there any way to include up to today's date in column L also, so that if I do not check the workbook for a number of days it will automatically include earlier dates prior to today's? Thank you very much for your help.
                  • To post as a guest, your comment is unpublished.
                    crystal · 2 years ago
                    Dear David,

                    Sorry I am not sure I got your question. If so, all rows will be moved as long as earlier dates appear in column L?
                    • To post as a guest, your comment is unpublished.
                      davidv@brc2.com · 2 years ago
                      Hi Crystal,

                      If I don't open my worksheet for a few days and the date entered in column L has now passed, i.e. the date in a cell in column L is September 11, 2017 but don't open my worksheet until September 13, I would like all the entries in column L to be checked for every date up to today's date then move the corresponding rows to the new sheet. Currently with the code you graciously provided, only rows with the current date in column L are moved to the new sheet leaving behind those with an earlier date in column L, which I currently move manually to the new sheet. Thanks for your help.
                      • To post as a guest, your comment is unpublished.
                        crystal · 2 years ago
                        Dear David,



                        I get your point. Please try the below VBA script. When open the workbook, all rows with dates up to today's date in column L will be moved to new specified sheet.



                        Private Sub Workbook_Open()
                        Dim xRg As Range
                        Dim xRgRtn As Range
                        Dim xCell As Range
                        Dim xLastRow As Long
                        Dim I As Long
                        Dim J As Long
                        On Error Resume Next
                        xLastRow = Worksheets("CURRENT OASIS OPPORTUNITIES").UsedRange.Rows.Count
                        If xLastRow < 1 Then Exit Sub
                        J = Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange.Rows.Count
                        If J = 1 Then
                        If Application.WorksheetFunction.CountA(Worksheets("ARCHIVED OASIS OPPORTUNITIES").UsedRange) = 0 Then J = 0
                        End If
                        Set xRg = Worksheets("CURRENT OASIS OPPORTUNITIES").Range("L1:L" & xLastRow)
                        For I = 2 To xLastRow
                        If xRg(I).Value > Date Then Exit Sub
                        If xRg(I).Value <= Date Then
                        xRg(I).EntireRow.Copy Destination:=Worksheets("ARCHIVED OASIS OPPORTUNITIES").Range("A" & J + 1)
                        xRg(I).EntireRow.Delete
                        J = J + 1
                        I = I - 1
                        End If
                        Next
                        End Sub

                        You need to put the VBA script into the ThisWorkbook code window and save the workbook as an Excel Macro-Enabled Workbook.
                        • To post as a guest, your comment is unpublished.
                          davidv@brc2.com · 2 years ago
                          Crystal, I was a bit hasty in responding that the code worked. I opened my workbook today and rows containing prior date entries in column L cell are still in the "current oasis opportunities worksheet" and have not moved to the "archived oasis worksheet" as expected. Any ideas why this would be the case?
                        • To post as a guest, your comment is unpublished.
                          davidv@brc2.com · 2 years ago
                          Thank you Crystal, That works just fine.
                          • To post as a guest, your comment is unpublished.
                            davidv@brc2.com · 2 years ago
                            Crystal, I was a bit hasty in responding that the code worked. I opened my workbook today and rows containing prior date entries in column L cell are still in the "current oasis opportunities worksheet" and have not moved to the "archived oasis worksheet" as expected. Any ideas why this would be the case?
                            • To post as a guest, your comment is unpublished.
                              davidv@brc2.com · 2 years ago
                              The highlighted cells are in column L in respect of the question above and are the criteria (up to today's date) for moving the row to the new worksheet. Hope this image helps.
                              • To post as a guest, your comment is unpublished.
                                davidv@brc2.com · 2 years ago
                                This is also a copy of the VBA window related to the above.
  • To post as a guest, your comment is unpublished.
    Moerman · 2 years ago
    Hi, I'm looking for a variation on this. I need the script to run continuously, or failing that whenever the value in that specific field changes. The code itself works but needs to be run independently. I'd like it to be automated. Can anyone assist?

    As an aside, if I only want it to copy over specific cells in the range, how is that accomplished?
    • To post as a guest, your comment is unpublished.
      crystal · 2 years ago
      Dear Rob,

      If you need the script to run automatically when cells in that field changed, the below VBA code can help you. Please right click current sheet (the sheet with rows you will move automatically) tab, then select View Code from the context menu. Then copy and paste the below VBA script into the Code window.

      Private Sub Worksheet_Change(ByVal Target As Range)

      Dim xCell As Range

      Dim I As Long
      On Error Resume Next

      Application.ScreenUpdating = False

      Set xCell = Target(1)
      If xCell.Value = "Done" Then
      I = Worksheets("Sheet2").UsedRange.Rows.Count
      If I = 1 Then

      If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then I = 0

      End If

      xCell.EntireRow.Copy Worksheets("Sheet2").Range("A" & I + 1)

      xCell.EntireRow.Delete
      End If

      Application.ScreenUpdating = True

      End Sub


      For your second question, do you mean just copy several cells instead of the whole row? Or would you please provide a screenshot of your question? Thank you!

      Best Regards, Crystal
      • To post as a guest, your comment is unpublished.
        Stusurrey · 3 months ago
        Hi Crystal
        This is the most useful info I have found on the web and this macro does what I want. But I am moving the rows from one table to another table - and with this macro the information moves ot the first free line outside of the table, not the next free line in the table? Can you help?
      • To post as a guest, your comment is unpublished.
        MaryJ · 2 years ago
        Crystal,


        Your help is more then needed :)



        How we can add another crtieria here, for example i would like to transfer Completed beside Done:


        Private Sub Worksheet_Change(ByVal Target As Range)

        Dim xCell As Range

        Dim I As Long
        On Error Resume Next

        Application.ScreenUpdating = False

        Set xCell = Target(1)
        If xCell.Value = "Done" Then
        I = Worksheets("Sheet2").UsedRange.Rows.Count
        If I = 1 Then

        If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then I = 0

        End If

        xCell.EntireRow.Copy Worksheets("Sheet2").Range("A" & I + 1)

        xCell.EntireRow.Delete
        End If

        Application.ScreenUpdating = True

        End Sub
  • To post as a guest, your comment is unpublished.
    sy · 3 years ago
    [quote name="Maddie"]hi, this was very helpful. Is there a way to do this without having the row of data moved to the second sheet, but rather having it copied? So the data would remain on both sheets?[/quote]


    did anybody resolve this
    • To post as a guest, your comment is unpublished.
      Jach · 2 years ago
      Remove this "xCell.EntireRow.Delete" from the code
      • To post as a guest, your comment is unpublished.
        bex · 2 years ago
        When I delete that line of code and run the macro again, Excel freezes. Why and how do I fix it?? I want the data to be on both worksheets and not to be deleted from the original. TIA
        • To post as a guest, your comment is unpublished.
          Kristel · 2 years ago
          is there an answer for this? Mine freezes as well I would like to copy but not delete the row
          • To post as a guest, your comment is unpublished.
            crystal · 2 years ago
            Good Day,
            The below VBA code can help you to only copy the rows instead of deleting them.

            Sub Cheezy()
            Dim xRg As Range
            Dim xCell As Range
            Dim I As Long
            Dim J As Long
            Dim K As Long
            I = Worksheets("Sheet1").UsedRange.Rows.Count
            J = Worksheets("Sheet2").UsedRange.Rows.Count
            If J = 1 Then
            If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
            End If
            Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
            On Error Resume Next
            Application.ScreenUpdating = False
            For K = 1 To xRg.Count
            If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            J = J + 1
            End If
            Next
            Application.ScreenUpdating = True
            End Sub
  • To post as a guest, your comment is unpublished.
    Bethany Gordon · 3 years ago
    What should I input if I want to include any date as my value? So the row stays on sheet 1 if it has no date, and moves to sheet 2 if it does?
  • To post as a guest, your comment is unpublished.
    kay · 3 years ago
    Sub Cheezy()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For Each xCell In xRg
    If CStr(xCell.Value) = "Done" Then
    xCell.EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
    xCell.EntireRow.Delete
    J = J + 1
    End If
    Next
    Application.ScreenUpdating = True
    End Sub



    how can add a second worksheet to have rows moved to sheet2?
  • To post as a guest, your comment is unpublished.
    francesco · 3 years ago
    Hi I am trying to use the code but I receive a syntax error on  Dim xCell As Range.

    Can you help please ?
  • To post as a guest, your comment is unpublished.
    Sampler · 3 years ago
    Hi,

    Very nice piece of code, working very well.
    How to change this code to move rows from one table to another table, instead of one sheet to another sheet?

    Many thanks !
  • To post as a guest, your comment is unpublished.
    Aafke Post · 3 years ago
    what would be the code if I want to copy rows (specific cells) into another sheet to specific cells? BUT also based upon a value

    Example:
    [b]color product images string[/b]
    white blender 2 whiteblender2
    black juicer 3 blackjuicer3
    red tv 1 redtv1
    green iron 4 greeniron4

    I would like the string copied to another sheet but the number in the images column tells how many times it should be copied (so, in this case, the blender string should be copied in 2 rows
  • To post as a guest, your comment is unpublished.
    bava · 3 years ago
    Hi the code was very helpful, but instead of the copying the entire row i require the a certain selection of row to be moved to the next sheet.

    how can i define a range instead of a entire row

    Sub Cheezy()
    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
    If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For Each xCell In xRg
    If CStr(xCell.Value) = "Done" Then
    xCell.[b]EntireRow[/b].Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
    J = J + 1
    End If
    Next
    Application.ScreenUpdating = True
    End Sub
  • To post as a guest, your comment is unpublished.
    Maddie · 3 years ago
    hi, this was very helpful. Is there a way to do this without having the row of data moved to the second sheet, but rather having it copied? So the data would remain on both sheets?
  • To post as a guest, your comment is unpublished.
    Yoav · 3 years ago
    If I wanted to have many values and many sheets to move my row to, I would have to write the whole code again with a different value for that cell?
    Meaning, if I put NA in one cell it goes to Na sheet, and if I put W# it will go to the wrong number sheet etc.