Macro Visual Basic Error al pegar datos en otra hoja si no hay nada que pegar después de filtrar
Tengo una macro que filtra en Hoja2 por dos tipos de productos, el producto A lo pega en "plantillauno" y el el producto B lo pega en "plantillados". El problema es que cuando hace el filtro si no existen algunos de esos productos (A o B) en la plantilla me pega la cabecera de cada campo. Y tengo puesto que copie desde la segunda Celda. No entiendo qué pasa! He probado a poner un If con If ultimafila > 1 que copie y pegue y sino pues que no haga nada, pero no lo tiene en cuenta.
Application.DisplayAlerts = True
' Copia/Pega un rango filtrado.
'Filtramos datos PRODUCTO A
'Quitamos filtro si lo hay
If Worksheets("Hoja2").FilterMode Then Worksheets("Hoja2").ShowAllData 'Quitamos el filtro
'filtramos
Worksheets("Hoja2").Range("AQ1").AutoFilter Field:=43, Criteria1:="A"
Dim UltimaFila As Long
'vamos copiando cada columna de Hoja2 y Rellenamos PlantillaUNO
'Para pegar los datos de las columnas C
Sheets("Hoja2").Activate
Let UltimaFila = Worksheets("Hoja2").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Hoja2").Range("AT2:AT" & UltimaFila).Copy Destination:=Worksheets("PlantillaUNO").Cells(7, 3)
'Para pegar los datos de las columnas H(...) (Etc. Y así con cada columna, el código es el mismo)
Cuando existen registros, copia desde hoja2 fila 2 (Range("AT2:AT" & UltimaFila). Copy) y lo pega en la fila 7 de la plantilla (Destination:=Worksheets("PlantillaUNO").Cells(7, 3)). Pero si no hay datos en el filtro, copia desde hoja2 fila1 y lo pega en la fila 6 de la plantilla. No entiendo qué sucede...
¿O algún modo de que me funcione el IF ultimafila > 1?
¿Alguna sugerencia?
1 respuesta
Prueba la siguiente:
Option Explicit
Sub CopiaDatos()
Dim uf As Long
Application.ScreenUpdating = False
With Sheets("Hoja2")
If .FilterMode Then .ShowAllData 'Quitamos el filtro
uf = .Range("AQ" & Rows.Count).End(3).Row
.Range("AQ1").AutoFilter Field:=43, Criteria1:="A"
.AutoFilter.Range.Range("AT1:AT" & uf).Offset(1).SpecialCells(xlCellTypeVisible).Copy Sheets("PlantillaUNO").Range("C7")
.ShowAllData
End With
End Sub
me pongo con ello y te digo! gracias!
Hola, Dante. Ya hice la prueba. Es que son muchísimas columnas. Funciona, al menos ahora ya no da error, pero siguen sin pegarse bien los datos en la plantilla. No sé si es por el cambio o por algo que te cuento ahora. En la plantilla la fila 5 está en blanco y la fila 6 es un encabezado FIJO, intento pegar los datos desde cada hoja a partir de la fila 7 de esas plantillas. El caso es que después de pegar los datos hay unos campos fijos en ese encabezado que voy arrastrando hacia abajo en función del número de registros. Bien, pues eso ya no lo hace... y por alguna razón pega los encabezados en la fila 5...
Te pongo el código:
If .FilterMode Then .ShowAllData 'Quitamos el filtro
uf = .Range("AQ" & Rows.Count).End(3).Row
.Range("AQ1").AutoFilter Field:=43, Criteria1:="A"
.AutoFilter.Range.Range("AT1:AT" & uf).Offset(1).SpecialCells(xlCellTypeVisible).Copy Sheets("PlantillaUNO").Range("C7") 'Para pegar los datos de las columnas C
.AutoFilter.Range.Range("AV1:AV" & uf).Offset(1).SpecialCells(xlCellTypeVisible).Copy Sheets("PlantillaUNO").Range("H7") 'pegar columna H
'A partir de aquí hay un código para arrastrar hacia abajo lo que hay entre las columnas C y H eso ya no lo hace, antes sí y en esto que te pongo no he cambiado nada, así que no sé dónde está el problema
Sheets("PlantillaUNO").Activate
'ARRASTRAMOS TODAS LAS CELDAS FIJAS DE plantillaUNO
uf = Range("C" & Rows.Count).End(xlUp).Row
Range("B6").AutoFill Destination:=Range("B6:B" & uf), Type:=xlFillDefault
Range("E6").AutoFill Destination:=Range("E6:E" & uf), Type:=xlFillDefault
Range("F6").AutoFill Destination:=Range("F6:F" & uf), Type:=xlFillDefault
Range("G6").AutoFill Destination:=Range("G6:G" & uf), Type:=xlFillDefault
'y arrastramos aparte la columna D que es un autonumérico partiendo de lo que marca la fila fija
[D7]=[D6]
Range("D7").Autofill Destination:= Range("D7:D" & uf), Type:=xlfillSeries
Antes de cambiar el código por lo que me comentaste, sí los arrastraba... pero desde que puse lo tuyo ya no da error si no hay datos al filtrar, así que bueno! sigo sin saber qué hacer.
Hola, Dante. Hice unas cuantas pruebas más y es que me di cuenta de que ni aplica el filtro, copia todos los registros... no hace bien el arrastrar... No hay alguna forma de meterle a mi código (aunque sea más largo) esta opción If ultimafila > 1 que ejecute mi macro y si no es así MsgBox ("no hay registros")? Lo probé a hacer así pero se lo salta...
Procura poner tu código con el icono para insertar código.
¿No hace el filtro?
¿Quieres filtrar la columna AQ? ¿Estamos hablando de la macro que yo actualicé o de otra macro?
Hola, Dante.
Es otra... no está funcionando bien. Sí, filtro en la columna AQ y esos datos los pego en la plantilla, columna por columna porque no coinciden:
.AutoFilter.Range.Range("AT1:AT" & uf).Offset(1).SpecialCells(xlCellTypeVisible).Copy Sheets("PlantillaUNO").Range("C7") 'Para pegar los datos de las columnas C
El caso es que puse tu código, le he dado muchas vueltas pero los datos no se filtran y en la plantilla no se pegan en la fila 7, y tampoco hace lo de arrastrar. Lo volví a dejar como tenía, pero sigo con el mismo problema. Si al filtrar no hay datos a la hora de pegarlos en la plantilla me sale un error... solo quería intentar poner un IF a mi código después del filtro IF ultimafila > 1 (o algo así) pues que entre en el proceso y si no es así por ejemplo MSGBOX ("no hay datos en el filtro")
pero no me sale...
Es otra... no está funcionando bien.
Antes de pasar a otro macro, puedes comentar sobre la respuesta que te envié.
Hola, Dante. Sí! Lo probé varias veces, no me funcionó. Y lo de arrastrar que viene a continuación tampoco lo hace, no lo entiendo... Mira, lo que quiero meter es justo cuando hace el filtro, decir que si no existen datos en el filtro, se salte todo esto y pase a lo siguiente. Había visto por ahí lo de IF ultimafila > 1 y que eso sirve para comprobarlo, pero no hace nada...
'Filtramos datos PRODUCTO_A
'Quitamos filtro si lo hay
If Worksheets("Hoja2").FilterMode Then Worksheets("Hoja2").ShowAllData 'Quitamos el filtro
'filtramos
Worksheets("Hoja2").Range("AQ1").AutoFilter Field:=43, Criteria1:="A"
Dim UltimaFila As Long
'vamos copiando cada columna de Hoja2 y Rellenamos PlantillaUNO
'Para pegar los datos de las columnas C
Sheets("Hoja2").Activate
Let UltimaFila = Worksheets("Hoja2").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Hoja2").Range("AT2:AT" & UltimaFila).Copy Destination:=Worksheets("PlantillaUNO").Cells(7, 3)
'Para pegar los datos de las columnas H
Let UltimaFila = Worksheets("Hoja2").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("Hoja2").Range("AV2:AV" & UltimaFila).Copy Destination:=Worksheets("PlantillaUNO").Cells(7, 8)
'ARRASTRAMOS TODAS LAS CELDAS FIJAS DE PlantillaUNO entre C y H
uf = Range("C" & Rows.Count).End(xlUp).Row
[D7] = [D6]
Range("D7").AutoFill Destination:=Range("D7:D" & uf), Type:=xlFillSeries
Range("E6").AutoFill Destination:=Range("E6:E" & uf), Type:=xlFillDefault
Range("F6").AutoFill Destination:=Range("F6:F" & uf), Type:=xlFillDefault
Range("G6").AutoFill Destination:=Range("G6:G" & uf), Type:=xlFillDefault
Prueba lo siguiente
Sub CopiaDatos()
Dim uf As Long
Application.ScreenUpdating = False
With Sheets("Hoja2")
If .FilterMode Then .ShowAllData 'Quitamos el filtro
uf = .Range("AQ" & Rows.Count).End(3).Row
.Range("A1:AQ" & uf).AutoFilter Field:=43, Criteria1:="A"
uf = .Range("AQ" & Rows.Count).End(3).Row
If uf = 1 Then
MsgBox "No existen datos"
Else
.AutoFilter.Range.Range("AT1:AT" & uf).Offset(1).SpecialCells(xlCellTypeVisible).Copy Sheets("PlantillaUNO").Range("C7")
End If
.ShowAllData
End With
End Sub
voy y te cuento!! gracias!
Hola, Dante. Ya lo he probado y funciona. Pero al terminar y decir que arrastre las celdas (ahí puse mi código) tengo un error cuando no hay datos. Me dice *no funciona el método Autofill de la clase .range
'ARRASTRAMOS TODAS LAS CELDAS FIJAS DE PlantillaUNO entre C y H
uf = Range("C" & Rows.Count).End(xlUp).Row
[D7] = [D6]
Range("D7").AutoFill Destination:=Range("D7:D" & uf), Type:=xlFillSeries
Puedes poner completa tu macro y me explicas qué necesitas.
Dante! Ya lo solucioné! Era un error mío! Con la solución que me diste sirvió! Solo tenía que corregir esa sentencia. Muchísimas gracias por todo!!
Siempre es un placer ayudarte, g racias por comentar.
