ayuda con macro

hola héctor¡¡¡¡

muchas gracias por tu ayuda, ya me funciona bien, lo único que
quisiera y debo cambiar (Y como cosa rara no se como), es que elimine
cuando hay mas de dos coincidencias, como ya lo hace, pero en vez de
eliminar desde la fila de abajo hacia arriba, lo haga desde la fila de
arriba y deje la última fila intacta si hay coincidencias, ya que las
de arriba son las antiguas

el segundo código me daba error porq no colocaba en el vínculo las
comillas simples en 'Obra' y lo solucione yo solito asi:

With Worksheets("Obras")

For k = 1 To 1
Worksheets("Obra").Copy Before:=Worksheets("Obra")
.Hyperlinks.Add _
Anchor:=.Range("g65536").End(xlUp).Offset(1), _
Address:="", _
SubAddress:="'" & ActiveSheet.Name & "'!A1"
.Activate
Next k
End With

jejjeje
Espero por tu ayuda y
de veras mil millones de gacias por tu atencion, no se que hubiese
hecho sin tu ayuda''¡¡¡

hola, Marco !

... quisiera y debo cambiar... que elimine cuando hay mas de dos coincidencias
... pero en vez de eliminar desde la fila de abajo hacia arriba... deje la ultima fila intacta
... ya que las de arriba son las antiguas [...]

solo necesitas invertir el 'conteo' y cuando el codigo llege al ultimo dato 'repetido' [si hay mas de dos]
lo deje 'fuera' del rango nuevo que va a ser eliminado ;)

si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

te paso el codigo completo...

Sub Eliminar_Mas_de_Uno()
Application.ScreenUpdating = False
Dim Celda As Range, Sig As Byte, Nuevo As Range, Ultimo As Byte
With ActiveSheet
If .AutoFilterMode Then .AutoFilterMode = False
With .Range(.Range("b14"), .Range("c65536").End(xlUp))
.AutoFilter Field:=1, Criteria1:=Worksheets("formato recolección datos").Range("j11")
.AutoFilter Field:=2, Criteria1:=Worksheets("formato recolección datos").Range("j12")
With .Parent.AutoFilter.Range
Ultimo = (.SpecialCells(xlCellTypeVisible).Count / 2)
If Ultimo > 2 Then
For Each Celda In .Offset(1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
Sig = Sig + 1
If Sig < Ultimo Then
If Nuevo Is Nothing Then Set Nuevo = Celda
Set Nuevo = Union(Nuevo, Celda)
End If
Next
End If
End With
.AutoFilter
End With
End With
If Not Nuevo Is Nothing Then Nuevo.EntireRow.Delete
Set Nuevo = Nothing
End Sub

Creo que voy a llorar¡¡¡¡ :(

ahora me borra todas las filas que coinciden con los
criterios¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡
ahhh y disculpa creo que escribi mal.al haber 2 coincidencias, no
mas de 2, que me borre la fila que estè más arriba

hola, Marco !

Creo que voy a llorar¡¡¡¡ :(
ahora me borra todas las filas que coinciden con los criterios¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡¡
ahhh y disculpa creo que escribi mal.al haber 2 coincidencias, no mas de 2, que me borre la fila que este mas arriba

tranquilo :D [solo espero que estes probando sobre copias de tus archivos originales] :))

prueba con las siguientes modificaciones [si hay mas de uno.. se eliminan 'los primeros' registros] ;)
si cualquier duda [o informacion adicional]... comentas ?
saludos,
hector.

Sub Eliminar_Mas_de_Uno()
Application.ScreenUpdating = False
Dim Ultimo As Byte, Celda As Range, Sig As Byte, Nuevo As Range
With ActiveSheet
If .AutoFilterMode Then .AutoFilterMode = False
With .Range(.Range("b14"), .Range("c65536").End(xlUp))
.AutoFilter Field:=1, Criteria1:=Worksheets("formato recolección datos").Range("j11")
.AutoFilter Field:=2, Criteria1:=Worksheets("formato recolección datos").Range("j12")
With .Parent.AutoFilter.Range
Ultimo = (.SpecialCells(xlCellTypeVisible).Count / 2) - 1
If Ultimo > 1 Then
For Each Celda In .Offset(1).Resize(.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
Sig = Sig + 1
If Sig < Ultimo Then
If Nuevo Is Nothing Then Set Nuevo = Celda
Set Nuevo = Union(Nuevo, Celda)
End If
Next
End If
End With
.AutoFilter
End With
End With
If Not Nuevo Is Nothing Then Nuevo.EntireRow.Delete
Set Nuevo = Nothing
End Sub

Wow que bien¡¡¡¡ ya funciona de maravilla'''¡¡¡¡¡
muchas gracias por tu ayuda.

oye como para no dejar es del mismo trabajo que estoy
haciendoya yo cree una macro que me hiciera el gráfico tomando él
mismo los datos(que no siempre son los mismos, es decir pueden ser mas)
al activar una macro, pero cada vez que inserto una fila se corre hacia
abajo y para imprimirlo tengo que cuadrarlo
no se como colocarlo en otra página,mejor dicho en otras paginas
porque son 2 graficos,ni como cambiar el estilo, ya he probado
infinidad de cosas, pero no funciona,
pero como se que eres el mejor en esto...jejejej ya lo demostrastes,
aqui te mando la macro para ver si me puedes dar una ayudita::))

Sub CrearGráfico()



Dim wksH As Worksheet, cGráfico As ChartObject, sSerie As Series

'Hoja donde están los datos y en la que situará el gráfico:
Set wksH = Worksheets("formato recolección datos")

'Crear nuevo gráfico:

Set cGráfico = wksH.ChartObjects.Add(200, 1050, 500, 300)


'Añadir una serie al gráfico:
Set sSerie = cGráfico.Chart.SeriesCollection.NewSeries
sSerie.Values = wksH.Range("I15", Range("I15").End(xlDown)) 'Rango
de datos
sSerie.XValues = wksH.Range("a15:a50") 'Rango para el eje X
sSerie.Name = "Monto Ejecutado"




'Añadir una serie al gráfico:
Set sSerie = cGráfico.Chart.SeriesCollection.NewSeries
sSerie.Values = wksH.Range("K15", Range("K15").End(xlDown)) 'Rango
de datos
sSerie.XValues = wksH.Range("a15:a20") 'Rango para el eje X
sSerie.Name = "Monto por Ejecutar"





'Crear nuevo gráfico:
Set cGráfico = wksH.ChartObjects.Add(200, 1530, 500, 300)

'Añadir una serie al gráfico:
Set sSerie = cGráfico.Chart.SeriesCollection.NewSeries
sSerie.Values = wksH.Range("j15", Range("j15").End(xlDown)) 'Rango
de datos
sSerie.XValues = wksH.Range("a15:a50") 'Rango para el eje X
sSerie.Name = "Porcentaje Ejecutado"



'Añadir una serie al gráfico:
Set sSerie = cGráfico.Chart.SeriesCollection.NewSeries
sSerie.Values = wksH.Range("l15", Range("l15").End(xlDown)) 'Rango
de datos
sSerie.XValues = wksH.Range("a15:a50") 'Rango para el eje X
sSerie.Name = "Porcentaje por Ejecutar"


Set sSerie = Nothing
Set cGráfico = Nothing
Set wksH = Nothing


End Sub