Saltar al contenido principal

¿Cómo mover la fila completa a otra hoja según el valor de la celda en Excel?

Para mover una fila completa a otra hoja según el valor de la celda, este artículo lo ayudará.

Mueva toda la fila a otra hoja según el valor de la celda con código VBA
Mueva toda la fila a otra hoja según el valor de la celda con Kutools para Excel


Mueva toda la fila a otra hoja según el valor de la celda con código VBA

Como se muestra en la siguiente captura de pantalla, debe mover toda la fila de Sheet1 a Sheet2 si existe una palabra específica "Listo" en la columna C. Puede probar el siguiente código VBA.

1. Prensa otro+ F11 teclas simultáneamente para abrir el Microsoft Visual Basic para aplicaciones ventana.

2. En la ventana de Microsoft Visual Basic para Aplicaciones, haga clic en recuadro > Módulo. Luego copie y pegue el siguiente código VBA en la ventana.

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: En el código, Sheet1 es la hoja de trabajo que contiene la fila que desea mover. Y Sheet2 es la hoja de trabajo de destino donde ubicará la fila. "C: C"Es la columna que contiene el valor determinado y la palabra"Terminado”Es el valor seguro en el que moverá la fila. Cámbielos según sus necesidades.

3. presione el F5 para ejecutar el código, la fila que cumpla con los criterios en Sheet1 se moverá a Sheet2 inmediatamente.

Note: El código VBA anterior eliminará las filas de los datos originales después de pasar a una hoja de trabajo específica. Si solo desea copiar filas según el valor de la celda en lugar de eliminarlas. Aplica el siguiente código VBA 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

Mueva toda la fila a otra hoja según el valor de la celda con Kutools para Excel

Si eres novato en el código VBA. Aquí les presento el Seleccionar celdas específicas utilidad de Kutools for Excel. Con esta utilidad, puede seleccionar fácilmente todas las filas según un determinado valor de celda o diferentes valores de celda en una hoja de trabajo, y copiar las filas seleccionadas a la hoja de trabajo de destino según lo necesite. Haz lo siguiente.

Antes de aplicar Kutools for Excel, Por favor descargarlo e instalarlo en primer lugar.

1. Seleccione la lista de columnas que contiene el valor de celda en el que moverá las filas, luego haga clic en Kutools > Seleccione > Seleccionar celdas específicas. Ver captura de pantalla:

2. En la apertura Seleccionar celdas específicas cuadro de diálogo, elija Fila completa existentes Tipo de selección sección, seleccionar Equivale existentes Tipo específico lista desplegable, ingrese el valor de la celda en el cuadro de texto y luego haga clic en el OK del botón.

Otra Seleccionar celdas específicas El cuadro de diálogo aparece para mostrarle el número de filas seleccionadas, y mientras tanto, todas las filas contienen el valor especificado en la columna seleccionada. Ver captura de pantalla:

3. presione el Ctrl + C claves para copiar las filas seleccionadas y luego pegarlas en la hoja de trabajo de destino que necesita.

Note: Si desea mover filas a otra hoja de trabajo en función de dos valores de celda diferentes. Por ejemplo, mueva filas según los valores de celda, ya sea "Listo" o "Procesando", puede habilitar el Or condición en el Seleccionar celdas específicas cuadro de diálogo como se muestra a continuación:

  Si desea tener una prueba gratuita (30 días) de esta utilidad, haga clic para descargarloy luego vaya a aplicar la operación según los pasos anteriores.


Artículos relacionados:

Las mejores herramientas de productividad de oficina

Características populares: Buscar, resaltar o identificar duplicados   |  Eliminar filas en blanco   |  Combine columnas o celdas sin perder datos   |   Ronda sin fórmula ...
Super búsqueda: Búsqueda virtual de criterios múltiples    Búsqueda V de valores múltiples  |   VLookup en varias hojas   |   Búsqueda difusa ....
Lista desplegable avanzada: Crear rápidamente una lista desplegable   |  Lista desplegable dependiente   |  Lista desplegable de selección múltiple ....
Administrador de columnas: Agregar un número específico de columnas  |  Mover columnas  |  Toggle Estado de visibilidad de columnas ocultas  |  Comparar rangos y columnas ...
Características destacadas: Enfoque de cuadrícula   |  Vista de diseño   |   Gran barra de fórmulas    Administrador de hojas y libros de trabajo   |  Biblioteca de Recursos (Texto automático)   |  Selector de fechas   |  Combinar hojas de trabajo   |  Cifrar/descifrar celdas    Enviar correos electrónicos por lista   |  Súper filtro   |   Filtro especial (filtro negrita/cursiva/tachado...) ...
Los 15 mejores conjuntos de herramientas12 Texto Herramientas (Añadir texto, Quitar caracteres, ...)   |   +50 Tabla Tipos (Diagrama de Gantt, ...)   |   40+ Práctico Fórmulas (Calcular la edad según el cumpleaños, ...)   |   19 Inserción Herramientas (Insertar código QR, Insertar imagen desde la ruta, ...)   |   12 Conversión Herramientas (Números a palabras, Conversión de Moneda, ...)   |   7 Fusionar y dividir Herramientas (Filas combinadas avanzadas, Células partidas, ...)   |   ... y más

Mejore sus habilidades de Excel con Kutools for Excel y experimente la eficiencia como nunca antes. Kutools for Excel ofrece más de 300 funciones avanzadas para aumentar la productividad y ahorrar tiempo.  Haga clic aquí para obtener la función que más necesita...

pestaña kte 201905


Office Tab lleva la interfaz con pestañas a Office y hace que su trabajo sea mucho más fácil

  • Habilite la edición y lectura con pestañas en Word, Excel, PowerPoint, Publisher, Access, Visio y Project.
  • Abra y cree varios documentos en nuevas pestañas de la misma ventana, en lugar de en nuevas ventanas.
  • ¡Aumenta su productividad en un 50% y reduce cientos de clics del mouse todos los días!
Comments (306)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hi,

I have a workbook with 9 sheets, the last 3 of which are irrelevant in terms of what I'm hoping to do. I keep all my data on Sheet1 (Sheet Name Withdrawn). I have used a code found here and modified it slightly to get closer to what I desire, but there are just a few features that I'm missing. Sheet1, Column B has a dropdown list. Lets call the dropdown choices "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Irrelevant1", "Irrelevant2", "Irrelevant3". On Sheet1, Column B, if "Sheet2" is chosen, I want that whole row to be copy and pasted into the first empty row on Sheet2. If "Sheet3" is chosen, I want the whole row to be copy and pasted to the first empty row in Sheet3. I want this same concept for choices "Sheet4", "Sheet5", and "Sheet6". I have accomplished all of this with the code I am using currently. I have also assigned a button to run this Macro.

Here's where I am coming up short from my ideal concept. I also want this to work so that when the choice in Sheet1, Column B is changed, it eliminates that row on the sheet that it was originally copy and pasted to. For instance, lets say I originally choose "Sheet2" from Column B in Sheet1, and therefore it copy and pastes this row to the first empty row in Sheet2. However, later I decide to change my choice in Sheet1, ColumnB for this row to "Sheet3". After hitting my button assigned to this Macro (Or better yet, if this process can somehow be automated), I want it to remove it from Sheet2 and now copy and paste it into Sheet 3, since that is what is chosen now in Sheet 1, Column B for that row. Also, if the choice in Sheet1, ColumnB is changed to "Irrelevant1", "Irrelevant2", or "Irrelevant3", I want it to remove it from all other sheets except Sheet1. Lastly, if a row is already copy and pasted to Sheet2, Sheet3, Sheet4, Sheet5, or Sheet6, I don't want it to be added again when the Macro is run again, which is what I have currenlty happening with my existing code.

Hope this isn't too hard to follow. I can share my workbook if it helps.
This comment was minimized by the moderator on the site
Thank you so much for this! It works very well, except like others who have commented -- I want the rows that move to be pasted in the first empty row. Is there a way to have it do that instead of going to the same row on the new sheet? Currently, if row 9 moves to a different sheet, it also fills row 9 on the new sheet. Thanks!

Code is:

Sub Done()
'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("Big KS Comms List").UsedRange.Rows.Count
J = Worksheets("DONE").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("DONE").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Big KS Comms List").Range("D1:D" & 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("DONE").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
This comment was minimized by the moderator on the site
dear Crystal,

thank you very much for your help but I require your guidance once more 😅

I'm using your code as Module for my worksheet to move finished inquiries, as follow:

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("Master").UsedRange.Rows.Count
J = Worksheets("Delivered").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Delivered").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Master").Range("M1:M" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "Delivered" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Delivered").Range("A" & J + 1)
xRg(K).EntireRow.Delete
If CStr(xRg(K).Value) = "Delivered" Then
K = K - 1
End If
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub


Also, to add date and time automatically, I'm using this code which doesn't seem to be working well with the Module:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range: Set M = Range("M:M")
Dim v As String
If Intersect(Target, M) Is Nothing Then Exit Sub

Application.EnableEvents = False
v = Target.Value
If v = "Agent Received" Then Target.Offset(0, 4) = Now()
If v = "Ready for Dispatch" Then Target.Offset(0, 2) = Now()
If v = "In Transit" Then Target.Offset(0, 3) = Now()
If v = "Delivered" Then Target.Offset(0, 5) = Now()
Application.EnableEvents = True
End Sub

by running the module, I end up with Error 13 type mismatch. Is there a way to fix this ?
Thank you.
This comment was minimized by the moderator on the site
Thank you very much for your help, all works fine.

for me it seems i have to Alt+F8 and run the module every time to get the rules working and rows moving.

is there a way to automate it ? thank you
This comment was minimized by the moderator on the site
Hi,

In the worksheet that contains the rows you want to move based on cell values, right-click the Worksheet tab and click View Code from the context menu, then add the following VBA code to the Worksheet (Code) window.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Kutools for Excel 2023/11/17
    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
This comment was minimized by the moderator on the site
I am using this code- it works OK BUT seems to be RANDOMLY placing the data on the Completed worksheet. I do not want it to overwrite any data- I would like it to ADD rows to a table or just to the spreadsheet.

Sub MoveRowsToComplete()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("To-Do List").UsedRange.Rows.Count
J = Worksheets("Completed").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Completed").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("To-Do List").Range("C1:C" & 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").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
This comment was minimized by the moderator on the site
I am moving the row from a table in one sheet to a table in another sheet, the issue I am having the row being moved over to the first available row in the table. It always moves it to the end of the table or the row after the end of the table. Are you able to provide any insight?
This comment was minimized by the moderator on the site
This has been the most helpful post! I have been trying to figure this out for a couple of weeks now and I can finally get my row to move. My question is. I have many tabs at the bottom and depending on the status in a specific column I would like them to go to that specific spreadsheet. I feel like I really configure it when I try to put more subs in.

Essentially, I have 8 tabs (worksheets) at the bottom and a drop down of statuses in column V of each of those tabs.
I would like to be able for the data to move and from worksheet to worksheet as needed based on the status.

I am only able to get this done for one (Form 1 to First Call)

Thank you for any help on being able to put multiple subs to get this accomplished.
This comment was minimized by the moderator on the site
Thanks for the superb code. I had to modify it a bit to make it work in connection with a project I had and found that it was less error prone in my version to have the for loop run in reverse and stepping back -1 which also eliminates the need for the K = K - 1 code line.
This comment was minimized by the moderator on the site
Wow! I love all the assistance you provide! Very cool!

Wondering if you may be able to help me...I have a workbook with two worksheets...One is for "Open Orders" and one is for "Closed Orders".

Currently, I have it set up so that there is a drop down list to determine if the work order is still open or in to be moved into closed status. When I choose "Closed" from the drop down list, I then hit Ctl/Shift/J and it moves it to the "Closed Orders" sheet adding it to the bottom row of the sheet. I then click on the "Closed Orders" sheet tab and use code to hit ctrl/shift/K to sort by the work order number.

Is there a way to automate everything so that when Idesignate the work order as "Closed" in the "Open Orders" sheet that it moves it to the "Closed Orders" sheet AND sorts by work order without having to do the ctrl/shift function in each sheet?

Thank you in advance for your assistance!!

Deb
This comment was minimized by the moderator on the site
Hi Deb,
I don't quite understand the "Sort" part you memtioned. Do you mind uploading your sample file here.
This comment was minimized by the moderator on the site
Hello, I posted a comment a moment ago but realised I completely mucked it up, so let's try again!

I'm trying to use this code but need to make a few tweaks and can't figure out how.

The value I'm looking for is "Unplanned" and needs to be in column H, but from H3 down (exclude H1 and H2).
Instead of copying the entire row, I need to copy from A:D.
When pasting into the next sheet, I need it to start at A3.

Any help would be greatly appreciated!
Thanks 😊
This comment was minimized by the moderator on the site
Ho Tess Laughlin,
The following code can help you solve the problem. Please give it a try. Thank you.
Sub Cheezy()
    'Updated by Kutools for Excel 20221128
    Dim xRg As Range
    Dim xStr As String
    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 = 2
    End If
    Set xRg = Intersect(Range("H3:H1048576"), Worksheets("Sheet1").UsedRange)
    If xRg Is Nothing Then Exit Sub
    
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Unplanned" Then
            xStr = CStr(K + 2)
            Range("A" & xStr & ":D" & xStr).Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub
This comment was minimized by the moderator on the site
This is great, thanks so much! :)
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations