Eliminar filas dependiendo de valor de celda

Gracias otra vez Ivan. Lo he hecho tal y como explicabas, quedando Value=0
(tal cual, sin el apóstrofe ni el punto que le sigue) y al ejecutar la macro
por segunda vez continua eliminando filas.
Supongo que en algo me equivoco o Value=0 tendría que estar en otra posición
del bucle.
¿Te importaria revisarlo si no es molestia? Feliz año 2007, 2008,
2009..hasta agotar los 15 dígitos de Excel.
Saludos, Gavillas.

"Ivan" escribió en el mensaje
news:
hola Gavillas

me refiero a quitar el apostrofe que hay justo delante de la V de
Value. Simplemente pon el cursor delante de -> ' Value = 0 y dale una
vez a Supr para que quede simplemente -> Value = 0 . (tambien en la
barra de herramientas del editor hay una opcion de "Bloque sin
comentarios" , mas o menos. Si posicionado en la fila le das a dicho
boton te quitara el apostrofe)

Cuando una linea de codigo lleva una comilla simple delante, VB no lo
toma en cuenta para la ejecucion del codigo. Se suele usar para añadir
'comentarios' aclaratorios/explicativos del codigo, o, como en este
caso, para probar un procedimiento con y sin una instruccion
determinada sin tener que borrarla/reescribirla.

no se si me habre explicado, en cualquier caso, lo que hace value=0 es
que la siguiente vez que ejcutes la macro, el valor de esa celda ya no
elimine ninguna fila posterior

espero te aclare algo

un saludo y hasta pronto
Ivan

hola Gavillas

solo tienes que quitar el apostrofe, el punto dejalo

un salyudo
ivan

hola de nuevo, Mariano, felices fiestas y mejor año

aunque supongo que andas liado todavia, aqui te mando esto para que le
eches un vistazo si puedes/quieres, y lo pruebes a ver que tal va con
tu archivo (sin prisas), que sera un poco mas real que mi montaje. Si
puedes comentas los resultados, sobre todo por curiosidad.

esta ya adaptado para los campos 'a:w' y 'x' para transponer. Solo
tendrias que cambiar el nombre de la hoja

'****************************************************************************
Sub TransParaMariano()
Dim nroF As Long, fInicio As Long
Dim Rango As String, tarda
Application.ScreenUpdating = False
tarda = Timer
With Worksheets("TU_HOJA") 'cambialo por el nombre de tu hoja
If .[a2] = "" Then Exit Sub
With .Range("a1:x" & .[a65536].End(xlUp).Row)
.Sort key1:=.Columns("v"), key2:=.Columns("w"), _
key3:=.Columns("x"), Header:=xlYes
.Sort key1:=.Columns("s"), key2:=.Columns("t"), _
key3:=.Columns("u"), Header:=xlYes
.Sort key1:=.Columns("p"), key2:=.Columns("q"), _
key3:=.Columns("r"), Header:=xlYes
.Sort key1:=.Columns("m"), key2:=.Columns("n"), _
key3:=.Columns("o"), Header:=xlYes
.Sort key1:=.Columns("j"), key2:=.Columns("k"), _
key3:=.Columns("l"), Header:=xlYes
.Sort key1:=.Columns("g"), key2:=.Columns("h"), _
key3:=.Columns("i"), Header:=xlYes
.Sort key1:=.Columns("d"), key2:=.Columns("e"), _
key3:=.Columns("f"), Header:=xlYes
.Sort key1:=.Columns("a"), key2:=.Columns("b"), _
key3:=.Columns("c"), Header:=xlYes
'OJO-> aqui he supuesto que tu ultima ordenacion en Excel ha sido
ascendente,
'si no es asi (creo que) deberias especifcar el parametro orden (
'Order1',
''Order2',..) para todas las Keys de ordenacion -> ej:
Order1:=xlAscending
'incluso no sobraria de todas formas
End With
fInicio = 2 'aqui he supuesto que los datos enpiezan en la fila
2(con encabezados
'en la 1), sino es asi cambialo por la fila siguiente a
tus encabezados
Do While .Range("a" & fInicio) <> ""
Rango = RangoIguales("TU_HOJA", fInicio, "w") 'aqui podrias poner
.Name
' en vez del nombre de tu hoja pero creo que ralentizaria(aunque
no
' lo he probado y podria ser al reves)
nroF = .Range(Rango).Rows.Count
If nroF > 1 Then
If nroF = 2 Then
.Range("x" & fInicio + 1).Copy .Range("y" & fInicio)
Else
.Range("x" & fInicio + 1 & ":x" & fInicio + nroF - 1).Copy
.Range("y" & fInicio).PasteSpecial SkipBlanks:=True, _
Transpose:=True
End If
End If
If nroF > 1 Then .Range("a" & fInicio + 1 & ":a" & _
fInicio + nroF - 1).EntireRow.Delete
fInicio = fInicio + 1
Loop
Application.CutCopyMode = False
End With
tarda = Timer - tarda
MsgBox "Tarda con funcion RangoIguales -> " & tarda
End Sub

' **************devuelve la referencia de un rango de filas/columnas
con datos
' iguales desde la fila pasada y hasta la columna
especificada***************
Function RangoIguales(ByVal hj As String, _
ByVal nFila As Long, _
ByVal colFin As String) As String
Dim sigF As Long, sigC As Integer
Dim finF As Long, finC As Integer
Dim col As String
With Worksheets(hj)
finF = .[a65536].End(xlUp).Row
finC = Asc(UCase(colFin)) - 65
sigC = 0
Do
sigC = sigC + 1
col = Chr(64 + sigC)
For sigF = nFila + 1 To finF
If .Range(col & sigF) <> .Range(col & sigF - 1) Then
finF = sigF - 1: Exit For
End If
Next
Loop Until sigC = finC
If finF < nFila Then finF = nFila
RangoIguales = .Range("a" & nFila & ":" & colFin & finF) _
.Address(0, 0)
End With
End Function
'*******************************************************************************

un saludo y hasta pronto
Ivan

hola de nuevo, Mariano, soy un pesado, pero por si en algun momento te
animas/puedes, cambia la funcion por esta otra version, bastante mas
rapida en mis pruebas

Function RangoIguales(ByVal hj As String, _
ByVal nFila As Long, _
ByVal colFin As String) As String
Dim sigF As Long, sigC As Integer
Dim finF As Long, finC As Integer
Dim col As String
With Worksheets(hj)
finF = .[a65536].End(xlUp).Row
finC = Asc(UCase(colFin)) - 64
Do
If finF = nFila Then Exit Do
col = Chr(64 + finC)
For sigF = nFila + 1 To finF
If .Range(col & sigF) <> .Range(col & sigF - 1) Then
finF = sigF - 1: Exit For
End If
Next
finC = finC - 1
Loop Until finC = 0
If finF < nFila Then finF = nFila
RangoIguales = .Range("a" & nFila & ":" & colFin & finF) _
.Address(0, 0)
End With
End Function

disculpa mi 'obsesividad', pero, como dice mi 'dueña', ..cuando me da
por algo.

un saludo
Ivan