Hola a todos, intento hacer una macro para pedir precio a proveedores. Aplico un filtro deseleccionando los valores que necesito (en el ejemplo Capítulo y Hormigón) y eliminando las filas filtradas, luego con el filtro muestro los datos que restan que son los que necesito que aparezcan y por último "guardo como" el archivo primitivo añadiendo lo indicado en M2 (en el ejemplo _HORMIGÓN) en el mismo directorio donde está el archivo base. Pero no sé como automatizar la macro para que lo haga para todos los posibles filtros a aplicar (siempre Capítulo + uds de columna pedir precio) y además siempre me lo guarda como "Excel base para macro_HORMIGÓN.xlsm". A ver si podéis echar una mano, ya que no sé como continuar porque lo de programar no lo controlo.

Un saludo y gracias por vuestra ayuda.

Excel base para macro.zip

Hola.

Puedes probar esta macro que elimina los registros que se indican en M2.

Sub filtrareliminar()
Dim rng As Range
Dim ult As Long
ult = Range("A" & Rows.Count).End(xlUp).Row
Set rng = Range("A3:L" & ult)
rng.AdvancedFilter xlFilterInPlace, Range("M1:M2"), True
rng.SpecialCells(xlCellTypeVisible) = ""
ActiveSheet.ShowAllData
End Sub

En M1 debes poner la palabra "CAPITULO" para el criterio del filtro, si te sirve asi continuamos con el guardado.

Un saludo.

Hola Toldeman, antes de nada agradecerte tu ayuda.

Lo que necesito es justo lo contrario, es decir que el filtro mantenga los registros que contienen M2 y elimine el resto. Además debiera eliminar también las filas afectadas por el filtro, no sólo borrar su contenido, lo digo porque normalmente el archivo donde aplicar la macro puede tener miles de registros y pueden quedar muchas filas vacías por el medio.

Si aplicas estos cambios lo comentamos.

Un saludo y muchas gracias.

Clic el corazon abajo a la derecha para agradecer el mensaje que te haya servido, gracias.

Hay va el archivo.

Un saludo.

P.S: saludos armando.

1.xls

Hola.

Borra las 2 macros y sustituyela por esta:

Sub filtrareliminar()
Dim ULT As Long
Dim rng As Range
Dim rng1 As Range
ULT = Range("A" & Rows.Count).End(xlUp).Row
Set rng = Range("A3:L" & ULT)
Set rng1 = Range("A4:L" & ULT)
rng.AdvancedFilter xlFilterInPlace, Range("N1:N2"), True
rng1.SpecialCells(xlCellTypeVisible).Delete xlUp
ActiveSheet.ShowAllData
End Sub

Un saludo.

Hola, he puesto CAPITULO en M1, he borrado las macros e insertado un nuevo módulo y pegado el código PHP. A continuación he ejecutado la macro y me da el siguiente error: "Se ha producido el error 1004 en tiempo de ejecución: Error en el método ShowAllData de la clase Worksheet". ¿No sé si estoy haciendo algo mal?. ¿Por qué no funciona correctamente?. Gracias.

- - - - - Mensaje combinado - - - - -

Perdón, ya sé por qué no funcionaba, lo había hecho sobre el archivo base que yo subí y no sobre el que tú enviaste ayer. Lo he probado de nuevo y funciona, pero no del todo como deseo. Te explico hay algunas unidades que tienen asignados más de una solicitud de precio (por ejemplo las hay con HORMIGÓN, FERRALLA, MO ENCOFRADO), necesito que cuando filtre por HORMIGÓN, también extraiga estos registros, es decir debe seleccionar todas las filas "que contienen" HORMIGÓN, independientemente de que en alguna de ellas haya más de una solicitud de precio. Espero haberme explicado bien. Un saludo

Hola.

Revisa el adjunto.

Saludos.

2.xls

Hola, el filtro funciona perfectamente, pero necesitaría que mantuviera también los capítulos al menos aquellos en los que existen unidades de obra de las que hay que pedir precio, si puede ser. En cualquier caso, prefiero que los mantenga todos a que sólo aparezca el primero. Si sólo aparecieran los capítulos de los que hay unidades a solicitar precio sería perfecto.

Un saludo.

Hola.

Revisa este adjunto.

Saludos.

1.xls

Hola, la macro rula perfectamente. Ahora me interesa que guarde el archivo en el mismo directorio añadiéndole al nombre inicial un guión bajo más lo indicado en M2.

Muchas gracias.

Hola.

cambia la primera macro por esta y la ruta de guardado:

Sub filtrareliminar()
Dim rng As Range
Dim rng1 As Range
Application.DisplayAlerts = False
nmb = ActiveWorkbook.Name
dr = nmb & "_" & Range("M2").Value & ".xls"
ActiveWorkbook.SaveAs "C:\Nueva carpeta\" & dr
ult = Range("A" & Rows.Count).End(xlUp).Row
Set rng = Range("A3:L" & ult)
Set rng1 = Range("A4:L" & ult)
Application.ScreenUpdating = False
rng.AdvancedFilter xlFilterInPlace, Range("N1:O2"), True
rng1.SpecialCells(xlCellTypeVisible).Delete xlUp
ActiveSheet.ShowAllData
borrar
Application.ScreenUpdating = True
ActiveWorkbook.SaveAs "C:\tu ruta\" & dr
End Sub

Saludos.

Hola, he cambiado la macro, pero me da error en la línea:

ActiveWorkbook.SaveAs "C:\Nueva carpeta\" & dr

Me sale el mensaje que te adjunto.[ATTACH]42490.vB[/ATTACH]

Hola.

Borra es linea, a mi se me olvido hacerlo, era una prueba.

Y donde pone C:/ruta/ escribes donde quieres que se guarde.

Saludos.

Sub filtrareliminar()
Dim rng As Range
Dim rng1 As Range
Application.DisplayAlerts = False
nmb = ActiveWorkbook.Name
dr = nmb & "_" & Range("M2").Value & ".xls"
ult = Range("A" & Rows.Count).End(xlUp).Row
Set rng = Range("A3:L" & ult)
Set rng1 = Range("A4:L" & ult)
Application.ScreenUpdating = False
rng.AdvancedFilter xlFilterInPlace, Range("N1:O2"), True
rng1.SpecialCells(xlCellTypeVisible).Delete xlUp
ActiveSheet.ShowAllData
borrar
Application.ScreenUpdating = True
ActiveWorkbook.SaveAs "C:\ruta\" & dr
End Sub

Hola, la macro va perfecta. Lo he probado en varias ubicaciones y con distintos filtros y no me ha dado error alguno. Sólo una última cuestión, el nombre me aparece de la siguiente forma "1.xls_HORMIGÓN.xls" ¿Sería posible que el primer .xls correspondiente a la extensión del archivo base no apareciera, es decir que quedara 1_HORMIGÓN.xls?

Muchas gracias por tu inestimable ayuda.

Hola prueba cambiando esto:

[COLOR=#000000][COLOR=#0000BB]dr [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000BB]nmb [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#DD0000]"_" [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#0000BB]Range[/COLOR][COLOR=#007700]([/COLOR][COLOR=#DD0000]"M2"[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000BB]Value [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#DD0000]".xls"

por :

[/COLOR][/COLOR][COLOR=#000000][COLOR=#0000BB]dr [/COLOR][COLOR=#007700]=[/COLOR][COLOR=#0000BB][/COLOR][COLOR=#007700][/COLOR][COLOR=#DD0000][/COLOR][COLOR=#007700][/COLOR][COLOR=#0000BB]Range[/COLOR][COLOR=#007700]([/COLOR][COLOR=#DD0000]"M2"[/COLOR][COLOR=#007700]).[/COLOR][COLOR=#0000BB]Value [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#DD0000]".xls"[/COLOR][/COLOR][COLOR=#000000][COLOR=#DD0000] 

Saludos.

[/color][/color]

Hola Toldeman, he estado haciendo pruebas con tu archivo y todo va perfecto. Bueno lo único que guarda el archivo sólo con lo indicado en M2 y no con el "nombre del archivo_M2.xls", pero tampoco me preocupa en exceso, así me valdría.

Tomando tu archivo como base le he incluido unas mediciones de obra algo más complejas, te adjunto el archivo, y he probado la macro. Lo hace casi todo bien, salvo que en todos los casos deja los 5 últimos registros sin que correspondan al filtro aplicado. A ver si puedes echarle un vistazo y me dices por qué el error.

Un saludo y muchas gracias por todo nuevamente. Eres un crack.

Excel base mediciones para macro.xls

Hola.

Prueba esto:

Sub filtrareliminar()
Dim rng As Range
Dim rng1 As Range
Application.DisplayAlerts = False
nmb = ActiveWorkbook.Name
dr = Range("M2").Value & ".xls"
ult = Range("L" & Rows.Count).End(xlUp).Row
Set rng = Range("A3:L" & ult)
Set rng1 = Range("A4:L" & ult)
Application.ScreenUpdating = False
rng.AdvancedFilter xlFilterInPlace, Range("N1:O2"), True
rng1.SpecialCells(xlCellTypeVisible).Delete xlUp
ActiveSheet.ShowAllData
borrar
ult = Range("L" & Rows.Count).End(xlUp).Row
If Range("L" & ult) = "CAPITULO" Then Rows(ult).Delete
Application.ScreenUpdating = True
ActiveWorkbook.SaveAs "C:\Datos\" & dr
End Sub
Sub borrar()
Dim ult As Long
ult = Range("L" & Rows.Count).End(xlUp).Row
If Range("L" & ult) = "CAPITULO" Then Rows(ult).Delete
ult = Range("L" & Rows.Count).End(xlUp).Row
For i = ult To 3 Step -1
If Range("L" & i) = "CAPITULO" And Range("L" & i).Offset(-1, 0) = "CAPITULO" Then
x = Range("L" & i).Offset(-1, 0).Row
Rows(x).Delete
End If
Next
End Sub

Saludos.

Hola, escribí ayer una respuesta y creí habértela mandado, pero parece que no fue así.

He probado la macro y funciona perfectamente.

Por último, dado que los archivos que se van a ir generando se los tengo que enviar a los proveedores me interesaría que una vez se ha creado el archivo, se eliminara la macro, la fila con los filtros aplicados, los criterios anotados en columnas M, N y O y el botón de macro. En definitiva que el archivo quedara limpio de todo lo utilizado para la aplicación de la macro.

Con esto dejo de darte más la brasa y para mí quedaría finiquitado el asunto.

Muchas gracias por todo. Un saludo.

No entiendo bien este ultimo requerimiento:

Cuando la macro se ejecuta te queda la hoja con lo filtrado y esta se detiene:

Apartir de ahi cuando quieres que se elimine todo lo que mencionas y que debe suceder para que esto ocurra.

Un saludo.

Hola. Voy a intentar aclarártelo. Cuando ya se ha ejecutado la macro y tenemos el archivo de salida, como este archivo yo se lo tengo que enviar a los proveedores para que me valoren las mediciones, se lo debo enviar únicamente con los datos hasta la columna K, por ello debo eliminar los datos incluidos en columnas L, M, N y O. Como la macro tampoco les vale al eliminar estos campos, pues lo mejor es eliminarla también, junto con el botón de ejecución. Lo que no sé es si esto se puede incluir en el código de esta macro o habría que programarlo aparte.

Si te complica en exceso lo dejamos como está.

Muchas gracias y un saludo.