Forum Discussion
How to move entire row to another sheet based on cell value in Excel
- Jul 14, 2023
Hi BlueMoose,
In Excel, as far as I know, it is not possible to achieve the desired functionality using formulas alone. This task typically requires the use of macros or VBA (Visual Basic for Applications) coding.
To accomplish your goal of pulling entire rows from one sheet to another based on the presence of the word "TIRES" in column X, you will need to use VBA. Here is an example of a VBA macro that could help you achieve this:
1. Press `Alt + F11` to open the VBA editor in Excel.
2. Insert a new module by clicking "Insert" > "Module".
3. Paste the following VBA code into the module:
Sub MoveRowsToTireCases()
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim lastRow As Long
Dim i As Long
' Set the source and target sheets
Set sourceSheet = ThisWorkbook.Worksheets("Cases")
Set targetSheet = ThisWorkbook.Worksheets("Tire Cases")
' Find the last row in the source sheet
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "X").End(xlUp).Row
' Loop through each row in the source sheet
For i = 2 To lastRow
' Check if cell in column X contains "TIRES"
If sourceSheet.Cells(i, "X").Value = "TIRES" Then
' Copy the entire row to the target sheet
sourceSheet.Rows(i).Copy Destination:=targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Offset(1)
' Delete the row from the source sheet
sourceSheet.Rows(i).Delete
' Decrement the loop counter as the rows are shifting up
i = i - 1
' Update the last row value
lastRow = lastRow - 1
End If
Next i
End Sub4. Modify the macro if your sheet names differ from "Cases" and "Tire Cases". Ensure that you keep the worksheet names within double quotes.
5. Close the VBA editor and return to your Excel workbook.
6. Press `Alt + F8` to open the "Macro" dialog box.
7. Select the "MoveRowsToTireCases" macro and click "Run"
By running this VBA macro, it should scan the "Cases" sheet, identify rows with "TIRES" in column X, and move those entire rows to the "Tire Cases" sheet. The rows shloud be copied to the bottom of the "Tire Cases" sheet and deleted from the "Cases" sheet. The macro will continue to work even as new rows with "TIRES" in column X are added to the "Cases" sheet.
Ensure that you save your workbook in a macro-enabled format (.xlsm) to retain the macro functionality.
I know that is not really a solution that you were lookin (hoping) for, but perhaps you can try it.
Please click Mark as Best Response & Like if my post helped you to solve your issue.
This will help others to find the correct solution easily. It also closes the item.If the post was useful in other ways, please consider giving it Like.
Kindest regards,
Leon Pavesic
LeonPavesic Hi, I copied the code you advised the original poster so I could use it for the same effect and it worked perfectly when i changed the sheet names etc so thanks for that.
The only thing I found is that when I refresh and the rows copy across to the target sheet, it doesnt add to the next row in the target sheet, it seems to simply overwrite the previous row that was copied.
Is this something to do with the loop counter?
LeonPavesic - As I mentioned, even if i update 10 rows of data with the right criteria to be moved to the target sheet (Lost), only one row is moving and the rest disappear completely. If there is already a row in the target sheet, it gets overwritten. Any advice would be amazing.....I am literally one week into trying to teach myself macros so im not the best at this but I need to find a way around it for a work report im doing!
Below is the code I have used for this but I cannot work out what has gone wrong.
Sub MoveToLost()
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim lastRow As Long
Dim i As Long
' Set the source and target sheets
Set sourceSheet = ThisWorkbook.Worksheets("Master")
Set targetSheet = ThisWorkbook.Worksheets("Lost")
' Find the last row in the source sheet
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "M").End(xlUp).Row
' Loop through each row in the source sheet
For i = 1 To lastRow
' Check if cell in column M contains "Lost"
If sourceSheet.Cells(i, "M").Value = "Lost" Then
' Copy the entire row to the target sheet
sourceSheet.Rows(i).Copy Destination:=targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Offset(1)
' Delete the row from the source sheet
sourceSheet.Rows(i).Delete
' Decrement the loop counter as the rows are shifting up
i = i - 1
' Update the last row value
lastRow = lastRow - 1
End If
Next i
End Sub
- HansVogelaarFeb 26, 2024MVP
Try this. Please test on a copy of your workbook first.
Sub MoveToLost() Dim sourceSheet As Worksheet Dim targetSheet As Worksheet Dim lastRow As Long Dim i As Long Dim targetRow As Long ' Set the source and target sheets Set sourceSheet = ThisWorkbook.Worksheets("Master") Set targetSheet = ThisWorkbook.Worksheets("Lost") ' Find the last row in the source sheet lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "M").End(xlUp).Row ' Last row in column M on the target sheet targetRow = targetSheet.Cells(targetSheet.Rows.Count, "M").End(xlUp).Row ' Loop through each row in the source sheet For i = lastRow To 1 Step -1 ' Check if cell in column M contains "Lost" If sourceSheet.Cells(i, "M").Value = "Lost" Then ' Increment target row targetRow = targetRow + 1 ' Copy the entire row to the target sheet sourceSheet.Rows(i).Copy Destination:=targetSheet.Cells(targetRow, 1) ' Delete the row from the source sheet sourceSheet.Rows(i).Delete End If Next i End Sub- echo_charlieApr 25, 2024Copper ContributorHansVogelaar
Hi Hans,
Thanks so much for your helpful input on this thread. Thanks to you I have achieved 99% of what I am looking to do for my team's project. The last 1% is, what if I'd like the row to be moved to the TOP of a different tab, rather than the bottom?
Here's the code I am working with, that is functioning perfectly, except new rows that get moved are going to the bottom of the target sheet.
Sub MoveToCompleted()
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim lastRow As Long
Dim i As Long
Dim targetRow As Long
' Set the source and target sheets
Set sourceSheet = ThisWorkbook.Worksheets("Requests")
Set targetSheet = ThisWorkbook.Worksheets("Completed")
' Find the last row in the source sheet
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
' Last row in column A on the target sheet
targetRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
' Loop through each row in the source sheet
For i = lastRow To 1 Step -1
' Check if cell in column A contains "Complete"
If sourceSheet.Cells(i, "A").Value = "Complete" Then
' Increment target row
targetRow = targetRow + 1
' Copy the entire row to the target sheet
sourceSheet.Rows(i).Copy Destination:=targetSheet.Cells(targetRow, 1)
' Delete the row from the source sheet
sourceSheet.Rows(i).Delete
End If
Next i
End Sub- HansVogelaarApr 25, 2024MVP
Does this do what you want?
Sub MoveToCompleted() Dim sourceSheet As Worksheet Dim targetSheet As Worksheet Dim lastRow As Long Dim i As Long ' Set the source and target sheets Set sourceSheet = ThisWorkbook.Worksheets("Requests") Set targetSheet = ThisWorkbook.Worksheets("Completed") ' Find the last row in the source sheet lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row ' Loop through each row in the source sheet For i = lastRow To 1 Step -1 ' Check if cell in column A contains "Complete" If sourceSheet.Cells(i, "A").Value = "Complete" Then ' Copy the entire row sourceSheet.Rows(i).Copy ' Insert in row 2 of the target sheet targetSheet.Rows(2).Insert ' Delete the row from the source sheet sourceSheet.Rows(i).Delete End If Next i End Sub
- FPRafApr 10, 2024Copper Contributor
Hi Hans,
Thanks for all the great responses I am getting close using the code I have pasted below!
I am trying to return unique numbers from column B of the "Ideate" tab to column B of the "Validate & Plan" tab on the next empty row of the "Validate & Plan" tab based off column X in the "Ideate" tab being "Yes".
The two problems I am running into are:
1) If for example projects 1 and 10 in column B of the "Ideate" tab are flagged as "Yes" in column X it will return 1 in the next empty row in column B of the "Validate & Plan" tab (i.e. B3), however, it will not return 10 below that, it will enter a formula i.e. "=B3+1" giving a value of 2. If project 25 was "Yes" as well, it would return a 3 below the 2 using the formula "=B4+1" giving a value of 3.
2) If I re-run the macro it will double count projects that have already been pulled across to the "Validate & Plan" tab i.e. project 1 will appear again in column B of the "Validate & Plan" tab. I only want new projects that have been tagged as "Yes" on the "Ideate" tab to be brought across in the next empty row. FYI all the project IDs are numerical and unique.
I hope this makes sense. Any help would be greatly appreciated.
---
Sub MoveRowsToTireCases()
Dim sourceSheet As Worksheet
Dim targetSheet As Worksheet
Dim lastRow As Long
Dim i As Long' Set the source and target sheets
Set sourceSheet = ThisWorkbook.Worksheets("Ideate")
Set targetSheet = ThisWorkbook.Worksheets("Validate & Plan")' Find the last row in the source sheet
lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "X").End(xlUp).Row' Loop through each row in the source sheet
For i = 6 To lastRow
' Check if cell in column X contains "Yes"
If sourceSheet.Cells(i, "X").Value = "Yes" Then
' Copy the entire row to the target sheet
sourceSheet.Cells(i, "B").Copy Destination:=targetSheet.Cells(targetSheet.Rows.Count, "B").End(xlUp).Offset(1)End If
Next i
End Sub- HansVogelaarApr 22, 2024MVP
Does this version do what you want?
Sub MoveRowsToTireCases() Dim sourceSheet As Worksheet Dim targetSheet As Worksheet Dim lastRow As Long Dim i As Long Dim v As Variant ' Set the source and target sheets Set sourceSheet = ThisWorkbook.Worksheets("Ideate") Set targetSheet = ThisWorkbook.Worksheets("Validate & Plan") ' Find the last row in the source sheet lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "X").End(xlUp).Row ' Loop through each row in the source sheet For i = 6 To lastRow ' Check if cell in column X contains "Yes" If sourceSheet.Cells(i, "X").Value = "Yes" Then v = sourceSheet.Cells(i, "B").Value ' Check whether value has already been copied If targetSheet.Range("B:B").Find(What:=v, LookIn:=xlValues, LookAt:=xlWhole) Is Nothing Then ' Copy the value to the target sheet targetSheet.Cells(targetSheet.Rows.Count, "B").End(xlUp).Offset(1).Value = v End If End If Next i End Sub