Tip: Other languages are Google-Translated. You can visit the English version of this link.
Log in
x
or
x
x
Register
x

or

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


Easily select entire rows based on cell value in a certian column:

The Select Specific Cells utility of Kutools for Excel can help you quickly select entire rows based on cell value in a certian column in Excel as below screenshot shown. After selecting all rows based on cell value, you can manually move or copy them to a new location as you need in Excel.

Kutools for Excel: with more than 200 handy Excel add-ins, free to try with no limitation in 60 days. Download the free trial Now!


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.

Kutools for Excel : with more than 300 handy Excel add-ins, free to try with no limitation in 60 days. 

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:

Tip.If you want to have a free trial of this utility, please go to download the software freely first, and then go to apply the operation according above steps.


Related articles:


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.
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.
    Erica · 1 months ago
    Does this not work if Column C is a drop down?
  • To post as a guest, your comment is unpublished.
    Mike · 1 months ago
    Kutools looks like a handy feature however, I don't know if it would work for what I'm trying to do.
    I'm trying to use advanced INDEX and MATCH functions to pull entire rows out of one sheet and move to another automatically. For instance, if I were to have 3 sheets open, let's say I copy data from an Internet database, put it in Excel format, copy it to Sheet 2. Once I do that, I have Sheet 1 automatically pulling a limited amount of data from Sheet 2 to automatically populate Sheet 1 already using the INDEX and MATCH functions. That part I have down using this function: INDEX(Sheet2!A:Q,ROW()-2,(MATCH("TicketFromSiteLeaseCompanyName",Sheet2!$A$1:$Q$1,0))). This particular formula I don't completely understand what each piece is, but pulls data from Sheet 2 under the column title "TicketFromSiteLeaseCompanyName" to Sheet 1 at that particular cell where this formula goes.
    What I'm trying to do is once Sheet 1 is done, use the INDEX and MATCH functions for Sheet 3 to take entire rows from Sheet 1 that the common factor would be an employees name and all the data that goes with it to Sheet 3. To get more specific, Sheet 3 would be renamed an employee's name and what I would like to do is set up a formula that would automatically populate Sheet 3 with just that employees information from Sheet 1 as the information is put into Sheet 1. By the way, there would be many many sheets after 3, each one having a different employees' name. I'm just using 3 sheets here total as a simple example.
    I was also thinking of using a pivot table but I would have to build it every time and that's what I'm trying to avoid. I want to make a template one time then all I'd have to do is populate Sheet 2 and every other sheet in the database should take care of itself.

    Any and all information on this would be extremely helpful Thank You.
  • To post as a guest, your comment is unpublished.
    Tyler · 2 months ago
    Hello - I love this code! Thanks so much. One thing I was wondering is how you could manipulate the code to pull in more than one piece of date. For ex. if the selected column contained "Done" and "Pending". I've tried a few different codes and couldn't get it.

    Any help would be greatly appreciated!

    Thanks again! :)
  • To post as a guest, your comment is unpublished.
    Rose · 2 months ago
    Hi, Thank you for your post! Currently, I have adapted your code to shift a row from one sheet to the other. Right now, I'm writing another module so that I can shift the row back to the original row position (in case where the cell value entry was entered wrongly). Would it be possible to allocate it back specifically to the row where it shifted from?
    • To post as a guest, your comment is unpublished.
      crystal · 10 hours ago
      Hi Rose,
      You can reverse the sheet names in the code to shift the row back to the original worksheet, but the row can't be allocated back to th original row position.
      Sorry for that.
      Thank you for your comment.
  • To post as a guest, your comment is unpublished.
    Natasha Leon · 2 months ago
    Hi

    I tried to read all of the comments but was unable to find the solution to my issue.
    I have 5 transaction codes (IPL, ISL, CAPO, IIC, IMO) in cell DC
    If cell DC = "ISL" or "IIC" or "IMO" then copy that row but only columns DE:FN to a new sheet in a new workbook
    If cell DC = "IPL" then copy that row but only columns DE:FN to a new sheet in another new workbook
    If cell DC = "CAPO" then copy that row but only columns DE:FN to a new sheet in another new workbook

    I want each new workbook sorted by the 14th column in the extracted range & saved in a specified location with the macro ending after the newly created workbooks have been closed.
  • To post as a guest, your comment is unpublished.
    Isaiah · 2 months ago
    Is there a way to prevent data from being duplicated when copied? I want to use this as sort of a long term log and the sheet I am entering data into is the weekly variant. I am copying my entries to a longterm yearly version. Currently this script produces duplicates each time an entry is made. I need to prevent these duplicates.
  • To post as a guest, your comment is unpublished.
    Stephen · 2 months ago
    Is there a way I could insert the row into the top row of a table on the second page?
    • To post as a guest, your comment is unpublished.
      crystal · 10 hours ago
      Hi Stephen,
      Sorry can't help you with that.
  • To post as a guest, your comment is unpublished.
    Aleksandar · 3 months ago
    Hi, how can I copy entire line based on values in row K and must be more then 0, I tried but...
    Thanks crystal :)
  • To post as a guest, your comment is unpublished.
    Harry · 3 months ago
    Hi, This thread has been really helpful. I was just wondering how I would modify the below code to only copy cells A & B for each "Done" row instead or the entire row.

    e.g. for row 6, C6 = "Done". How would i copy only cells A6 & B6 across to the next sheet instead of the entire row



    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


    Thank you in advance
    • To post as a guest, your comment is unpublished.
      crystal · 10 hours ago
      Hi Harry,
      Try this VBA code. Hope I can help.

      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 'Data
      End If
      Set xRg = Worksheets("Sheet1").Range("C1:C" & 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), "Done") > 0 Then
      Range("A" & xRg(K).Row & ":" & "B" & xRg(K).Row).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

      Sub EnableEvents()
      Application.EnableEvents = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Jackson · 3 months ago
    I am using your code, however I encounter an error with line 8 (below) when I run the macro

    I = Worksheets("Sheet1").UsedRange.Rows.Count

    I'm at a loss as to why this may be occurring, would this macro be affected by there being several drop down lists in the row? or by applied conditional formatting?
    • To post as a guest, your comment is unpublished.
      crystal · 3 months ago
      Hi Jackson,
      The macro doesn't be affected by drop-down lists as well as conditional formatting.
      Have you change the sheet name in this line to your actually used sheet name?
  • To post as a guest, your comment is unpublished.
    Hassan Arshad · 3 months ago
    Hi, could you please help me out how can I use this with activex control button e.g. when I press the button then data move to sheet2? Thank you so much
    • To post as a guest, your comment is unpublished.
      crystal · 3 months ago
      Hi Hassan Arshad,
      Right click the activex control button and select View Code from the context menu, then copy the below code between the Private Sub and the End Sub lines.

      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
  • To post as a guest, your comment is unpublished.
    Bradley · 4 months ago
    How do I make the VBA code run automatically? When the cell I am targeting changes to the value, it is not deleting and moving. I have to open the dialog and run it.
    • To post as a guest, your comment is unpublished.
      Laurie Black · 2 months ago
      Make sure to add Developer tab first

      On the Developer tab, in the Code group, click Macros.
      In the Macro name box, click the macro you want to run and press the Run button.

      You will also have the choice to add a shortkey from here
  • To post as a guest, your comment is unpublished.
    Andrew · 6 months ago
    This is a HUGE help, thank you! Is there a way to move rows if values are less than a given value?
  • To post as a guest, your comment is unpublished.
    Anne · 8 months ago
    Hello, thank you so much for this post. Instead of only "Done" I have several words to find, it can be around 100. I have them all in Column A of Sheet 2. I need to find those words from Sheet 1 and paste the entire row(s) in sheet 3, if the words match. How can I do that? I would really appreciate your help.
  • To post as a guest, your comment is unpublished.
    Anju · 8 months ago
    Hi, I have a sheet where are liscence renewal details are present, when the due date is nearing (before 2 months) those liscence details need to sent as an email to a single recipient. I have used today formula and calculated the days remaining from the due date. So I am using that cell- if the value is above 60, it must copy the entire cell and put it into another workbook. It has to repeat this until it reaches the end. could you help me writing a code on this ?
  • To post as a guest, your comment is unpublished.
    Anne · 8 months ago
    Hello, thank you so much for this code. How To Move Entire Row To Another Sheet Based On a column? Let's say in sheet 2, I have Case IDs in column A. And I need to find anything associated with those Case IDs in Sheet 1 and paste it in Sheet 3. Can you please help me do that?
    • To post as a guest, your comment is unpublished.
      crystal · 7 months ago
      Hi Anne,
      Sorry can't help you with that. Thank you for your comment.
  • To post as a guest, your comment is unpublished.
    TJ · 8 months ago
    Thanks, this helped me alot. I am not an Excel expert! I used the the module in VBA you created to transfer rows from Sheet 1 to Sheet 2. My project is that I'm moving objects to designated locations that were set up in a certain order in another column located in Sheet 1. When I run the module, I lose the location because the rows shift up in Sheet 1 after the transfer. I have to insert a row and type in the designated location again. Can it be set up so that I can at least keep the blank row and just type in the location needed?
  • To post as a guest, your comment is unpublished.
    SB · 9 months ago
    Thank you! If it is not too much trouble could you please post how to have the destination data overwrite vs. append to the last line? Specifically to overwrite data starting at A2. Thank you!
    • To post as a guest, your comment is unpublished.
      crystal · 3 months ago
      Good Day,
      For moving data and overwrite data starting at A2 in the destination worksheet, please apply the below code.

      Sub MoveRowOverwrite()
      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 CStr(xRg(K).Value) = "Done" Then
      xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
      xRg(K).EntireRow.Delete
      J = J + 1
      End If
      Next
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    Charlene · 9 months ago
    I have a drop down list to code which person transfers to which sheet. But I can only get one person to transfer with your code. Help? :)
    • To post as a guest, your comment is unpublished.
      crystal · 7 months ago
      Hi Charlene,
      The following VBA code can help you solve the problem. Please change the "PERSON1" and "PERSON2" to the person as you need. In this case, the row of PERSON1 will be moved to Sheet2, and the row of PERSON2 will be moved to Sheet3.

      Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      Dim xRg As Range
      Dim xCell As Range
      Dim xRRg1 As Range
      Dim xRRg2 As Range
      Dim xDWS As Worksheet
      Dim xLWS As Worksheet
      Dim xEWS As Worksheet
      Dim xDR, xLR, xER As Long
      Dim xDC As Long
      Dim K As Long
      Dim xC1 As Long
      Dim xFNum As Long
      Set xDWS = Worksheets("Sheet1")
      Set xLWS = Worksheets("Sheet2") 'LIVE
      Set xEWS = Worksheets("Sheet3") 'ENDED
      xDR = xDWS.UsedRange.Rows.Count
      xLR = xLWS.UsedRange.Rows.Count
      xER = xEWS.UsedRange.Rows.Count
      xDC = xDWS.UsedRange.Columns.Count
      If xLR = 1 Then
      If Application.WorksheetFunction.CountA(xLWS.UsedRange) = 0 Then xLR = 0
      End If
      If xER = 1 Then
      If Application.WorksheetFunction.CountA(xEWS.UsedRange) = 0 Then xER = 0
      End If
      Set xRg = xDWS.Range("C1:C" & xDR)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.Count
      If CStr(xRg(K).Value) = "PERSON1" Then
      Set xRRg1 = xRg(K).EntireRow
      Set xRRg2 = xLWS.Range("A" & xLR + 1).EntireRow
      For xFNum = 1 To xDC
      xRRg2.Value = xRRg1.Value
      Next xFNum
      xRg(K).EntireRow.Delete
      xLR = xLR + 1
      ElseIf CStr(xRg(K).Value) = "PERSON2" Then
      Set xRRg1 = xRg(K).EntireRow
      Set xRRg2 = xEWS.Range("A" & xER + 1).EntireRow
      For xFNum = 1 To xDC
      xRRg2.Value = xRRg1.Value
      Next xFNum
      xRg(K).EntireRow.Delete
      xER = xER + 1
      End If
      Next K
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    CAROL · 10 months ago
    I am using the formula to move rows to a second tab and delete the row from the first tab...it is deleting the row in the first tab, but not moving the row to the second. I'm wondering if it is because I have not give the correct qualifier to "A" in row 18 of the formula?? What is the "A" for?
    • To post as a guest, your comment is unpublished.
      crystal · 10 months ago
      Hi Carol,
      The "A" in row 18 means that the qualified row will be moved to the first column in the given sheet.
  • To post as a guest, your comment is unpublished.
    Carol · 10 months ago
    I'm trying to use the formula to move rows to another tab while deleting the row in the original tab. The formula deletes from the original tab, but does not move the information. I'm wondering if it is because I have not given a qualifier for the "A" in line 18 of the module. What is that for?
  • To post as a guest, your comment is unpublished.
    tom · 10 months ago
    This is AMAZING! how would I modify to capture 2 criteria?? Ex: Cell in main workbook column C = 'Done'...and column A shows either 'Tom', 'Dick', or 'Harry'. I have a tabs in the workbook for Tom, Dick, and Harry.... so if row had Done and Tom, it would be appended to the end of the spreadsheet on the Tom tab.
  • To post as a guest, your comment is unpublished.
    pawJ · 11 months ago
    works more or less. It copy's the right ine, but does not copy it to the first line in the given sheet. It leaves a number of empty lines at first
  • To post as a guest, your comment is unpublished.
    Robert Mayer · 11 months ago
    Hello Crystal,


    I am using VBA 1 and it is working great. I added the automatic code to my sheet to automate the process and when i put in the trigger word it deletes that line and all of the lines below it, wiping out my entire table.


    Do you have any suggestions?


    Thank you,
    Robert
    • To post as a guest, your comment is unpublished.
      crystal · 10 months ago
      Hi Robert Mayer,
      Your automatic code should be as follows.

      Private Sub Worksheet_SelectionChange(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("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
      Please have a try. If problem still exists, please let me know and tell me your Excel version.
      Thanks you for your comment.
  • To post as a guest, your comment is unpublished.
    Scott · 11 months ago
    How can move the selected row and paste it as a "Value". My selection has formulas, so when it is moved I get a lot of ref errors since it's still tied to the original formula.
    • To post as a guest, your comment is unpublished.
      crystal · 11 months ago
      Hi Scott,
      The below VBA code can solve the problem, please have a try. Thank you for your comment.

      Sub Cheezy01()
      Dim xRg As Range
      Dim xCell As Range
      Dim xRRg1 As Range
      Dim xRRg2 As Range
      Dim I As Long
      Dim J As Long
      Dim K As Long
      Dim xC1 As Long
      Dim xFNum As Long
      Dim xDShName As String
      Dim xRShName As String
      xDShName = "Sheet1"
      xRShName = "Sheet2"
      I = Worksheets(xDShName).UsedRange.Rows.count
      J = Worksheets(xRShName).UsedRange.Rows.count
      xC1 = Worksheets(xDShName).UsedRange.Columns.count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets(xRShName).UsedRange) = 0 Then J = 0
      End If
      Set xRg = Worksheets(xDShName).Range("C1:C" & I)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.count
      If CStr(xRg(K).Value) = "Done" Then
      Set xRRg1 = xRg(K).EntireRow
      Set xRRg2 = Worksheets(xRShName).Range("A" & J + 1).EntireRow

      xRRg2.Value = xRRg1.Value

      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
  • To post as a guest, your comment is unpublished.
    liam · 1 years ago
    Hi, This works great and is very helpful but can you explain how I would do the following?

    I have column "M" which has "LIVE" & "ENDED", I have used your code to work so that "LIVE" goes to "Sheet2" but how do I add more code so that "ENDED" is copied to "Sheet3"?

    Thank you
    • To post as a guest, your comment is unpublished.
      Anne · 8 months ago
      Good question, what about if I have several of those "LIVE" "ENDED" "DONE" "GONE" "SUNDAY" etc... It can be up to 89, they are listed in a column.
    • To post as a guest, your comment is unpublished.
      crystal · 11 months ago
      Hi Liam,
      Please try the following VBA code. Hope it can help and thank you for your comment.

      Sub Cheezy()
      Dim xRg As Range
      Dim xCell As Range
      Dim xRRg1 As Range
      Dim xRRg2 As Range
      Dim xDWS As Worksheet
      Dim xLWS As Worksheet
      Dim xEWS As Worksheet
      Dim xDR, xLR, xER As Long
      Dim xDC As Long
      Dim K As Long
      Dim xC1 As Long
      Dim xFNum As Long
      Set xDWS = Worksheets("Sheet1")
      Set xLWS = Worksheets("Sheet2") 'LIVE
      Set xEWS = Worksheets("Sheet3") 'ENDED
      xDR = xDWS.UsedRange.Rows.count
      xLR = xLWS.UsedRange.Rows.count
      xER = xEWS.UsedRange.Rows.count
      xDC = xDWS.UsedRange.Columns.count
      If xLR = 1 Then
      If Application.WorksheetFunction.CountA(xLWS.UsedRange) = 0 Then xLR = 0
      End If
      If xER = 1 Then
      If Application.WorksheetFunction.CountA(xEWS.UsedRange) = 0 Then xER = 0
      End If
      Set xRg = xDWS.Range("C1:C" & xDR)
      On Error Resume Next
      Application.ScreenUpdating = False
      For K = 1 To xRg.count
      If CStr(xRg(K).Value) = "LIVE" Then
      Set xRRg1 = xRg(K).EntireRow
      Set xRRg2 = xLWS.Range("A" & xLR + 1).EntireRow
      For xFNum = 1 To xDC
      xRRg2.Value = xRRg1.Value
      Next xFNum
      xRg(K).EntireRow.Delete
      xLR = xLR + 1
      ElseIf CStr(xRg(K).Value) = "ENDED" Then
      Set xRRg1 = xRg(K).EntireRow
      Set xRRg2 = xEWS.Range("A" & xER + 1).EntireRow
      For xFNum = 1 To xDC
      xRRg2.Value = xRRg1.Value
      Next xFNum
      xRg(K).EntireRow.Delete
      xER = xER + 1
      End If
      Next K
      Application.ScreenUpdating = True
      End Sub
  • To post as a guest, your comment is unpublished.
    R3 · 1 years ago
    Hi, I get a syntax error on the line:

    Set xRg = Worksheets("Maternity Sub-Committee ACCC").Range("B:B" & I)

    Can you please help me? Thanks
    • To post as a guest, your comment is unpublished.
      Guest · 1 years ago
      For your range, it needs to be "B1:B". That will make it work!
  • To post as a guest, your comment is unpublished.
    AV · 1 years ago
    I used this code previously without problems, but now I can't get it to work quite right (I have no VB coding experience, so probably a silly mistake). Everything works except the row I want doesn't get copied to the final destination of Sheet2 - nothing appears there. Original row deleted just fine from Sheet1. I do have a header row in Sheet2 - could that be a problem?
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Good day,
      The problem you mentioned does not appear in my case. Do you mind uploading your workbook for me to check?
      Thanks for your comment.
  • To post as a guest, your comment is unpublished.
    D company · 1 years ago
    Not working for me !!!!! please help!!!!



    I am getting syntax error on first line Sub Cheezy()
    What changes I need to do to fix this.
    I made changes as mentioned in description.
  • To post as a guest, your comment is unpublished.
    Ramesh · 1 years ago
    It is not working for me please help!!!!!!



    its giving me an syntax error at first line Sub Cheezy().


    I copped code as it is and changed values mentioned in description.
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi Ramesh,
      May I know your Office verson? I need the feedback to check for the error. Thanks for your comment.
  • To post as a guest, your comment is unpublished.
    Ryan · 1 years ago
    I'm trying to move cells with a VLOOKUP function and when I use the code below, it pastes the formula, but it moves the cell values down as it pastes the formula down the rows. For example... the row that I'm copying is looking up $A1:$B27. When it pastes on the next sheet using the Macro it pastes $A2:$B29 then $A3:$B30 and so on and so forth. Is there a fix for this either in my VBA code or in my VLOOKUP formula?
  • To post as a guest, your comment is unpublished.
    gowtham · 1 years ago
    Hi,

    If i add the data in sheet1 it is not moving automatically,how to copy the data to another sheets
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi gowtham,
      If you want to automatically move the row after entering the data, please try the below VBA code.

      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.
        Steph · 1 years ago
        Do you add this in place of Sub Cheezy()'s VBA, or in addition to? If so, where do you place it? (VBA newbie here)
      • To post as a guest, your comment is unpublished.
        Kim · 1 years ago
        Hello Crystal,

        Good day! I have been following your posts and I really appreciate all the tips and tricks you've been giving to everyone.
        Is it possible to help me please on my current challenge? I have been working on a file where I need to check if the value on the cell is found on a range from another sheet, then move it to another sheet.

        Here's my scenario

        Sheet1, range B2:B100 contains the range of values that serve as masterdata/list

        Sheet2, column C is what should be checked - if value is found on sheet1 range B2:B100

        Sheet3: If Sheet 2 Column C data is found, then entire row is moved to Sheet3.

        I have been using your early reference www.extendoffice.com/documents/excel/372....html?page_comment=1

        but it is only for a single criteria.



        Thank you in advance!
        • To post as a guest, your comment is unpublished.
          crystal · 1 years ago
          Hi Kim,
          The below VBA code can help you solve the problem. Thanks for your comment.

          Sub Cheezy()
          'Updated by Kutools for Excel 2018/8/6

          Dim xRg As Range
          Dim yRg As Range
          Dim I As Long
          Dim K As Long
          Dim J As Long

          I = Worksheets("Sheet1").UsedRange.Rows.Count
          J = Worksheets("Sheet3").UsedRange.Rows.Count
          secRow = Worksheets("Sheet2").UsedRange.Rows.Count
          If J = 1 Then
          If Application.WorksheetFunction.CountA(Worksheets("Sheet3").UsedRange) = 0 Then J = 0
          End If

          Set xRg = Worksheets("Sheet1").Range("B2:B100")
          'Set xRg = Worksheets("Sheet1").Range("A1:C" & I)
          Set yRg = Worksheets("Sheet2").Range("C1:C" & secRow)

          On Error Resume Next
          Application.ScreenUpdating = False
          Dim M As Long
          Dim N As Long

          For N = 1 To xRg.Count
          For M = 1 To yRg.Count
          If CStr(xRg(N).Value) = CStr(yRg(M).Value) Then
          yRg(M).EntireRow.Copy Destination:=Worksheets("Sheet3").Range("A" & J + 1)
          yRg(M).EntireRow.Delete
          If CStr(xRg(N).Value) = CStr(yRg(M).Value) Then
          N = N - 1
          End If
          J = J + 1
          End If
          Next

          Next

          Application.ScreenUpdating = True
          End Sub
          • To post as a guest, your comment is unpublished.
            Kim · 1 years ago
            Hi Crystal, Thank you! This worked for me.

            Going back to the original codes to move rows to another worksheet. It's been working for me for sometime.

            Now I have this issue where, whenever I start to trigger the macro, the cut cells are not moved to the next blank rows.

            E.g. I have A1:Z1 as my headers, the data starts to fill rows A33 onwards.

            Have you encountered this before?


            One thing I did though is that I have copied the macro into different buttons, and tailor fit depending on what sheet I need to paste. Does that impact the original sheet? or any sheets? Thank you.
  • To post as a guest, your comment is unpublished.
    kassidy · 1 years ago
    This vba works perfectly for what I need to do, except I want the values pasted into Sheet 2 in a specific range. So, if sheet 1 data meets my criteria, it needs to populate into a formatted table on sheet 2. This table allows my data to be pasted from C6:H39. Is there anyway to change the code so that the data isn't pasted into the next available row on sheet 2?
  • To post as a guest, your comment is unpublished.
    Veer · 1 years ago
    Hi,
    Thanks for the the code above...its every helpful.
    I wanted one more help...can we have a code which will create a new row (entire row) in sheet 2 as it is doing now but only specific column data is pasted...

    Eg. Sheet 1 has say 7 columns - Client Name, Product, Address,Qty, Amount, Date, Order Status
    In sheet 2 i want only 4 columns- Client Name,Product, Amount, Date

    Now in sheet2 these 4 columns will populate from sheet 1 and rest columns relating to order processing will be entered by user.

    Thank in advance...
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Good day,
      Can't help with this. Thanks for your comment.
  • To post as a guest, your comment is unpublished.
    Jessica · 1 years ago
    The code for copying to a new sheet worked as expected. The issue I'm having is that I need to pull data from 3 sheets into a 4th sheet.

    How can I alter this to include data from "Sheet 1", "Sheet 2", and "Sheet 3" and copy it to "Sheet 4"?
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi Jessica,
      Thanks for your comment. Please try the below VBA code to solve your problem.

      Sub CopyRowBasedOnCellValueInWorksheets()
      Dim xWSArray As Variant
      Dim xWs, xDWs As Worksheet
      Dim xRg As Range
      Dim xCell As Range
      Dim xFNum As Integer
      Dim xDStr As String
      Dim I As Long
      Dim J As Long
      Dim K As Long

      WSArray = Array("Sheet1", "Sheet2", "Sheet3")
      xDStr = "Sheet4"
      On Error Resume Next
      Set xDWs = Worksheets(xDStr)
      J = xDWs.UsedRange.Rows.count
      If J = 1 Then
      If Application.WorksheetFunction.CountA(xDWs.UsedRange) = 0 Then J = 0
      End If
      Application.ScreenUpdating = False
      For xFNum = LBound(WSArray) To UBound(WSArray)
      On Error GoTo Error1
      Set xWs = Worksheets(WSArray(xFNum))
      I = xWs.UsedRange.Rows.count
      Set xRg = xWs.Range("C1:C" & I)
      For K = 1 To xRg.count
      If CStr(xRg(K).Value) = "Done" Then
      xRg(K).EntireRow.Copy Destination:=xDWs.Range("A" & J + 1)
      J = J + 1
      End If
      Next
      Error1:
      Next xFNum
      Application.ScreenUpdating = True

      End Sub
  • To post as a guest, your comment is unpublished.
    Andrew · 1 years ago
    I was also trying to figure out how to move items in columns A - E while deleting the whole row, but when it copies to the last row in the second sheet, it only checks for inputs in columns A - E. So if I have a drop-down menu in column F, it still copies to that row.
  • To post as a guest, your comment is unpublished.
    Andrew · 1 years ago
    Hi Crystal,

    I was wondering if there was a way to copy just the text in the row? Not the color or fill.
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Good day,
      If you just want to move the text in the row, please try the following VBA code.

      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 = 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
      Worksheets("Sheet2").Range("A" & J + 1).PasteSpecial xlPasteValues
      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
      • To post as a guest, your comment is unpublished.
        sam · 1 years ago
        I need to do this too but nothave my original data be deleted???
  • To post as a guest, your comment is unpublished.
    Bre · 1 years ago
    I have used this in my macro for quite a few months now but I just recently ran into an issue and I am trying to figure out how to get it to properly work again. I have it wrote to move anything that says "Paper" in column T to the Paper Tab but in the recent report I got all of the items ended up being labeled "Paper". So when I manually step through it it will move them properly but then it just keeps going. It doesn't even stop looping through. When I just run the macro by itself it is freezing the Excel document and never finishing. When i manually add something random in column T at the end of the spreadsheet the macro runs just fine. Any help without me having to add something random to be added in if all cells contain the same thing??
  • To post as a guest, your comment is unpublished.
    Gwen · 1 years ago
    Do you have any suggestions for how to make the code work so that it moves a row to the new sheet if there are numbers in the target column, but not if the column reads Pending? I can get it to work in a mockup spreadsheet but not the one I need to change. Thanks!
  • To post as a guest, your comment is unpublished.
    Janelle · 1 years ago
    Hi there,

    I think this is what I am looking for, but I have 4 values I need it to split between sheets how would I do that? For instant, if column L contains a "1" it copies columns a:d to sheet 2, if column L contains "2" it copies columns a:d to sheet 3 and so on. Is this possible?
  • To post as a guest, your comment is unpublished.
    chris · 1 years ago
    Hi,

    i need something to copy and delete rows where column L says "closed" and move the row to another tab/sheet called "closed orders". i tried the script above and it didnt work for my sheet but it did work when i did a test sheet with just 3 coumns.
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Dear chris,
      The code works well in my case. Have you replaced C1:C in the code with L1:L to meet your needs?
  • To post as a guest, your comment is unpublished.
    Ben · 1 years ago
    What if I didn't want to copy the entire row, but a limited amount of columns of that row?
    • To post as a guest, your comment is unpublished.
      crystal · 1 years ago
      Hi Ben,
      Please try the below VBA code. The code can help you copy cells A - J from current worksheet "Sheet1" to another one "Data", and delete the ENTIRE row from the "Sheet1" once it has been copied over to the "Data" sheet. 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.
    Beth · 1 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 · 1 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.
    Beth · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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 · 1 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.
    Wendy · 1 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 · 1 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 · 1 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 · 1 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.