Ayuda con este codigo.

12/10/2006 - 18:29 por Alejandro Garcia | Informe spam

Este codigo lo puso KL como respuesta a una persona de este foro hace
unos días, yo habia puesto un post un tanto parecido y pense que podria
adecuarlo a mis necesidades pero no he podido, ¿alguien me podria
colaborar un poco?. Mi problema, eliminar fila de la hoja Activos
dependiendo de una condicion, que en la columna H tenga X, estos
registros deben pasar a otra hoja del mismo libro llamada Retirados,
esta nueva fila(en retirados) puede ir al final de la hoja(la hoja ya
existe). ¿Sera esto posible?, Gracias de antemano.

El codigo:
Sub Creating_New_Sheet()
Application.ScreenUpdating = False
Sheets(ActiveSheet.Name).Copy After:=ActiveSheet
With ActiveSheet.Range("H:H")
On Error Resume Next
Do
.Find _
(What:="A", _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext).EntireRow.Delete
Loop Until Err.Number <> 0
End With
End Sub

Esta Macro lo que hace es crear una nueva hoja y pasar las filas que
tengan X a esa nueva hoja, yo ya tengo creada la hoja y lo que deseo es
anexar dichas filas al final de esa hoja.

Siga el debate

9 respuestas

Tengo una respuesta

Preguntas similare

Mostrar todos los temas similares

Leer las respuestas

#6 J.P.

17/10/2006 - 16:37 | Informe spam

Buen día
Les cuento, disculpen soy muy principiante y cometo errores, que luego
me doy cuenta.
Puedes probar con este codigo, el anterior tenia un error y era que
solo cortaba la primera columna, pues de ahi en adelante ya estaba
ubicado en la hoja retirados.

Sub EliminarRetirados()
Dim celda As Range
Dim c() As Integer
Dim i As Integer
Dim j As Integer
Sheets("Activos").Select
'En esta parte defino cuantas columnas son las que hay que cortar
For Each celda In Range("H:H")
If celda.Value = "X" Then
i = i + 1
End If
Next
'incluyo las columnas en un vector para luego cortarlas
'Es igual que al de arriba pero si quieren el anterior pueden oviarlo y
definir
'c() con algun indice, en la definición, este tiene que ser por lo
menos
'igual a las filas cortadas, por eso opto por realizar el paso anterior
ReDim c(i)
i = 0
For Each celda In Range("H:H")
If celda.Value = "X" Then
i = i + 1
c(i) = celda.Row
End If
Next
'Corto las columnas
For j = 1 To i
Sheets("Activos").Cells(c(j), 1).EntireRow.Cut
Sheets("Retirados").Select
Range("A65536").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next
'borro las columnas
For j = i To 1 Step -1
Sheets("Activos").Cells(c(j), 1).EntireRow.Delete
Next
End Sub

Bueno si alguien sabe como puedo simplificar el codigo para hacer mas
rapida la ejecución, les agradeceria que me lo hicieran saber.

Espero les sirva.

Responder a este mensaje

#7 Gavillas

19/10/2006 - 20:19 | Informe spam

Gracias J.P. ahora si que funciona.
Ademas, tus comentarios por partes son muy instructivos.

Un saludo, Gavillas.

"J.P." escribió en el mensaje
news:
Buen día
Les cuento, disculpen soy muy principiante y cometo errores, que luego
me doy cuenta.
Puedes probar con este codigo, el anterior tenia un error y era que
solo cortaba la primera columna, pues de ahi en adelante ya estaba
ubicado en la hoja retirados.

Sub EliminarRetirados()
Dim celda As Range
Dim c() As Integer
Dim i As Integer
Dim j As Integer
Sheets("Activos").Select
'En esta parte defino cuantas columnas son las que hay que cortar
For Each celda In Range("H:H")
If celda.Value = "X" Then
i = i + 1
End If
Next
'incluyo las columnas en un vector para luego cortarlas
'Es igual que al de arriba pero si quieren el anterior pueden oviarlo y
definir
'c() con algun indice, en la definición, este tiene que ser por lo
menos
'igual a las filas cortadas, por eso opto por realizar el paso anterior
ReDim c(i)
i = 0
For Each celda In Range("H:H")
If celda.Value = "X" Then
i = i + 1
c(i) = celda.Row
End If
Next
'Corto las columnas
For j = 1 To i
Sheets("Activos").Cells(c(j), 1).EntireRow.Cut
Sheets("Retirados").Select
Range("A65536").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next
'borro las columnas
For j = i To 1 Step -1
Sheets("Activos").Cells(c(j), 1).EntireRow.Delete
Next
End Sub

Bueno si alguien sabe como puedo simplificar el codigo para hacer mas
rapida la ejecución, les agradeceria que me lo hicieran saber.

Espero les sirva.

Responder a este mensaje

#8 J.P.

31/10/2006 - 22:35 | Informe spam

Este codigo es más rapido en tiempo de ejecución que el anterior

Sub EliminarRetirados()

Dim celda As Range
Dim c() As Integer
Dim hoj As Worksheet
Dim i As Integer
Dim l As Integer

Set hoj = Worksheets("Activos")
Sheets("Activos").Select
Range("H65536").Select
i = Selection.End(xlUp).Row
Sheets("Activos").Cells(1, 1).Activate
ReDim c(i) As Integer
For Each celda In hoj.Range(Cells(1, 8), Cells(i, 8))
If celda.Value = "X" Or celda.Value = "x" Then
l = l + 1
c(l) = celda.Row
celda.EntireRow.Cut
Sheets("Retirados").Select
Range("A65536").Select
Selection.End(xlUp).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next

For i = l To 1 Step -1
hoj.Cells(c(i), 1).EntireRow.Delete
Next

Sheets("Retirados").Cells(1, 1).Activate

End Sub

El ciclo no se hace en toda la columna H sino hasta donde encuentre la
última X ó x

Gavillas ha escrito:

Mostrar la cita