Macro VBA eliminar filas según valores de una celda para Excel
Tengo una tabla de excel en la cual periódicamente se registraran valores duplicados en algunas columnas, debido a que se van ingresando todos los días nuevos datos. Lo que se necesita es ir transfiriendo en una hoja distinta los datos, que están:"Rechazados, Aceptados y Limitados" e ir eliminándolos y así solo ir dejando los que están "En Proceso".
Para poder realizar la macro es necesario insertarla en un botón.
Logre hacer transferir los datos a otra hoja, pero me falta ir eliminando los datos.
Sub TransferirDatos()
Dim Codigo As String
Dim Nombre As String
Dim Area As String
Dim Estado As String
Dim ultimaFila As Long
Dim ultimaFilaHoja As Long
Dim cont As Long
ultimaFila = Sheets("INGRESO Y EGRESO").Range("J" & Rows.Count).End(xlUp).Row
For cont = 9 To ultimaFila
Estado = Sheets("INGRESO Y EGRESO").Cells(cont, 5)
Codigo = Sheets("INGRESO Y EGRESO").Cells(cont, 2)
Nombre = Sheets("INGRESO Y EGRESO").Cells(cont, 3)
Area = Sheets("INGRESO Y EGRESO").Cells(cont, 4)
If Estado = "Aprobado" Then
ultimaFilaHoja = Sheets("INSTRUMENTOS APROBADOS").Range("B" & Rows.Count).End(xlUp).Row
Sheets("INSTRUMENTOS APROBADOS").Cells(ultimaFilaHoja + 1, 2) = Codigo
Sheets("INSTRUMENTOS APROBADOS").Cells(ultimaFilaHoja + 1, 3) = Nombre
Sheets("INSTRUMENTOS APROBADOS").Cells(ultimaFilaHoja + 1, 4) = Area
Sheets("INSTRUMENTOS APROBADOS").Cells(ultimaFilaHoja + 1, 5) = Estado
ElseIf Estado = "Rechazado" Then
ultimaFilaHoja = Sheets("INSTRUMENTOS APROBADOS").Range("B" & Rows.Count).End(xlUp).Row
Sheets("INSTRUMENTOS APROBADOS").Cells(ultimaFilaHoja + 1, 2) = Codigo
Sheets("INSTRUMENTOS APROBADOS").Cells(ultimaFilaHoja + 1, 3) = Nombre
Sheets("INSTRUMENTOS APROBADOS").Cells(ultimaFilaHoja + 1, 4) = Area
Sheets("INSTRUMENTOS APROBADOS").Cells(ultimaFilaHoja + 1, 5) = Estado
ElseIf Estado = "Limitado" Then
ultimaFilaHoja = Sheets("INSTRUMENTOS APROBADOS").Range("B" & Rows.Count).End(xlUp).Row
Sheets("INSTRUMENTOS APROBADOS").Cells(ultimaFilaHoja + 1, 2) = Codigo
Sheets("INSTRUMENTOS APROBADOS").Cells(ultimaFilaHoja + 1, 3) = Nombre
Sheets("INSTRUMENTOS APROBADOS").Cells(ultimaFilaHoja + 1, 4) = Area
Sheets("INSTRUMENTOS APROBADOS").Cells(ultimaFilaHoja + 1, 5) = Estado
End If
Next cont
MsgBox "Transferencia realizada exitosamente !", vbInformation, "Resultado"
End Sub
1 respuesta
H o l a
La macro copia si cumple las condiciones a la hoja2 y elimina los datos copiados de la hoja1
Necesito las columnas, yo asumí que las condiciones está en la E, la fila 2 empieza tus datos fuera del encabezado.
Sub CopiarDatos_elimina()
'Por Dante
'Act. Adriel ortiz
Application.ScreenUpdating = False
Set h1 = Sheets("Hoja1")
Set h2 = Sheets("Hoja2")
j = h2.Range("E" & Rows.Count).End(xlUp).Row + 1
For i = h1.Range("E" & Rows.Count).End(xlUp).Row To 2 Step -1
If h1.Cells(i, "E") = "Aceptados" And h1.Cells(i, "E") = "Rechazados" And _
h1.Cells(i, "E") = "Limitados" Then
h1.Rows(i).Copy
h2.Range("A" & j).PasteSpecial xlValues
h1.Rows(i).Delete
j = j + 1
End If
Next
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "Copia Finalizada"
End SubValora la respuesta como Excelente o bueno saludos
