Cortar filas con valor específico y pegarlas en otra h
Que tal Experto calvuch.
¿Podrías por favor apoyarme nuevamente?
En la Hoja 1 tengo una tabla validando el campo "Departamento" con Cajas de Lista que permite seleccionar los diferentes departamentos.
Ejemplo:
Nombre Antigüedad Departamento
Carlos 3 años Contabilidad
Eduardo 10 años RH
Gerardo 5años Contabilidad
Fernando 2años logística
Luis 7 años RH
Lo que se requiere es un botón a un costado de la tabla que al hacer clic en él, corte y envié los registros que tengan los departamentos Contabilidad y RH a la última fila vacía de la Hoja 2.
Además de eliminar las filas originales en donde estaban los registros que tenían dichos departamentos.
De antemano agradezco tu ayuda.
¿Podrías por favor apoyarme nuevamente?
En la Hoja 1 tengo una tabla validando el campo "Departamento" con Cajas de Lista que permite seleccionar los diferentes departamentos.
Ejemplo:
Nombre Antigüedad Departamento
Carlos 3 años Contabilidad
Eduardo 10 años RH
Gerardo 5años Contabilidad
Fernando 2años logística
Luis 7 años RH
Lo que se requiere es un botón a un costado de la tabla que al hacer clic en él, corte y envié los registros que tengan los departamentos Contabilidad y RH a la última fila vacía de la Hoja 2.
Además de eliminar las filas originales en donde estaban los registros que tenían dichos departamentos.
De antemano agradezco tu ayuda.
1 respuesta
Respuesta de calvuch
1
Ok
Private Sub CommandButton1_Click()
Dim i As Long
Hoja1.Range("A65536").Formula = "=COUNTA(R[-65535]C:R[-1]C)"
Hoja2.Range("A65536").Formula = "=COUNTA(R[-65535]C:R[-1]C)"
If Hoja1.Range("A65536") = 0 Then Exit Sub
Hoja1.Select
For i = 2 To Hoja1.Range("A65536").Value + 1
If Range("C" & i).Value = "Contabilidad" Or Range("C" & i).Value = "RH" Then
Hoja1.Rows(i & ":" & i).Select
Selection.Cut
Hoja2.Select
Hoja2.Rows(Hoja2.Range("A65536").Value + 1 & ":" & Hoja2.Range("A65536").Value + 1).Select
ActiveSheet.Paste
Hoja1.Select
End If
DoEvents
Next
MsgBox "Terminado", vbInformation
End Sub
En hoja 1 los datos deben estar desde la fila 2
Private Sub CommandButton1_Click()
Dim i As Long
Hoja1.Range("A65536").Formula = "=COUNTA(R[-65535]C:R[-1]C)"
Hoja2.Range("A65536").Formula = "=COUNTA(R[-65535]C:R[-1]C)"
If Hoja1.Range("A65536") = 0 Then Exit Sub
Hoja1.Select
For i = 2 To Hoja1.Range("A65536").Value + 1
If Range("C" & i).Value = "Contabilidad" Or Range("C" & i).Value = "RH" Then
Hoja1.Rows(i & ":" & i).Select
Selection.Cut
Hoja2.Select
Hoja2.Rows(Hoja2.Range("A65536").Value + 1 & ":" & Hoja2.Range("A65536").Value + 1).Select
ActiveSheet.Paste
Hoja1.Select
End If
DoEvents
Next
MsgBox "Terminado", vbInformation
End Sub
En hoja 1 los datos deben estar desde la fila 2
Que tal calvuch.
Agradezco tu tiempo y pronta respuesta.
El código funciona muy bien, excepto un detalle. No elimina las filas que quedaron vacías al mandar los registros que cumplen con el criterio de "Contabilidad" y "RH".
Quedo atento a tus comentarios.
Agradezco tu tiempo y pronta respuesta.
El código funciona muy bien, excepto un detalle. No elimina las filas que quedaron vacías al mandar los registros que cumplen con el criterio de "Contabilidad" y "RH".
Quedo atento a tus comentarios.
A ver ahora, prueba esto
Private Sub CommandButton1_Click()
Dim i As Long
Dim N As Long
Hoja1.Range("A65536").Formula = "=COUNTA(R[-65535]C:R[-1]C)"
Hoja2.Range("A65536").Formula = "=COUNTA(R[-65535]C:R[-1]C)"
If Hoja1.Range("A65536") = 0 Then Exit Sub
N = Hoja1.Range("A65536")
Hoja1.Range("A65536").Clear
Hoja1.Select
Hoja1.Range("A" & N + 1).Value = "stp"
For i = 2 To N + 1
If Range("C" & i).Value = "Contabilidad" Or Range("C" & i).Value = "RH" Then
Hoja1.Rows(i & ":" & i).Select
Selection.Cut
Hoja2.Select
Hoja2.Rows(Hoja2.Range("A65536").Value + 1 & ":" & Hoja2.Range("A65536").Value + 1).Select
ActiveSheet.Paste
Hoja1.Select
End If
DoEvents
Next
i = 0
' ELIMINAR
Hoja1.Select
For i = 2 To (N + 1)
If Range("A" & i).Value = "stp" Then Exit For
If Range("A" & i).Value = Empty Then
Hoja1.Rows(i & ":" & i).Select
Selection.Delete Shift:=xlUp
If Range("A" & i).Value = Empty Then Hoja1.Rows(i & ":" & i).Select: Selection.Delete Shift:=xlUp
Else
If Range("A" & (i - 1)).Value = Empty Then Hoja1.Rows((i - 1) & ":" & (i - 1)).Select: Selection.Delete Shift:=xlUp
End If
DoEvents
Next
Range("A" & i).Clear
Range("A2").Select
MsgBox "Terminado", vbInformation
End Sub
En hoja1 la celda A1 no debe estar vacía ( debe haber un rotulo o cualquier cosa)
Private Sub CommandButton1_Click()
Dim i As Long
Dim N As Long
Hoja1.Range("A65536").Formula = "=COUNTA(R[-65535]C:R[-1]C)"
Hoja2.Range("A65536").Formula = "=COUNTA(R[-65535]C:R[-1]C)"
If Hoja1.Range("A65536") = 0 Then Exit Sub
N = Hoja1.Range("A65536")
Hoja1.Range("A65536").Clear
Hoja1.Select
Hoja1.Range("A" & N + 1).Value = "stp"
For i = 2 To N + 1
If Range("C" & i).Value = "Contabilidad" Or Range("C" & i).Value = "RH" Then
Hoja1.Rows(i & ":" & i).Select
Selection.Cut
Hoja2.Select
Hoja2.Rows(Hoja2.Range("A65536").Value + 1 & ":" & Hoja2.Range("A65536").Value + 1).Select
ActiveSheet.Paste
Hoja1.Select
End If
DoEvents
Next
i = 0
' ELIMINAR
Hoja1.Select
For i = 2 To (N + 1)
If Range("A" & i).Value = "stp" Then Exit For
If Range("A" & i).Value = Empty Then
Hoja1.Rows(i & ":" & i).Select
Selection.Delete Shift:=xlUp
If Range("A" & i).Value = Empty Then Hoja1.Rows(i & ":" & i).Select: Selection.Delete Shift:=xlUp
Else
If Range("A" & (i - 1)).Value = Empty Then Hoja1.Rows((i - 1) & ":" & (i - 1)).Select: Selection.Delete Shift:=xlUp
End If
DoEvents
Next
Range("A" & i).Clear
Range("A2").Select
MsgBox "Terminado", vbInformation
End Sub
En hoja1 la celda A1 no debe estar vacía ( debe haber un rotulo o cualquier cosa)
