Como copiar solo celdas que contengan datos
Tengo un archivo donde me manejo con dos hojas, en uno tengo una tabla con un encabezado y debajo de ella cargo datos (en algunas celdas) y en la otra hoja, tengo tipo una presentación para imprimir. Necesito que cargando un numero de pedido, me traiga los datos que cargue en esa de la hoja. Muestro lo que quiero hacer, va a ser mas fácil que explicarlo. Saludos.
Te anexo la macro
Sub Copiar_Valores()
'Por.Dante Amor
Set h1 = Sheets("INDICE CLT18") 'hoja con datos
Set h2 = Sheets("IMPRESION") 'hoja presentación para imprimir
'
valor = h2.Range("F9")
If valor = "" Then
MsgBox "Introduce el dato a buscar"
Exit Sub
End If
'
Set b = h1.Columns("A").Find(valor, lookat:=xlWhole)
If Not b Is Nothing Then
u = h2.Range("D" & Rows.Count).End(xlUp).Row
n = 18
wtot = 0
If u < 18 Then u = 18
h2.Range("D18:E" & u).ClearContents
uc = h1.Cells(13, Columns.Count).End(xlToLeft).Column
For j = Columns("B").Column To uc
If h1.Cells(b.Row, j) <> "" Then
h2.Cells(n, "D") = h1.Cells(13, j)
h2.Cells(n, "E") = h1.Cells(b.Row, j)
wtot = wtot + h1.Cells(b.Row, j)
n = n + 1
End If
Next
h2.Cells(n, "D") = "Total"
h2.Cells(n, "E") = wtot
Else
MsgBox "El dato no existe"
End If
End SubCambia en la macro "IMPRESION" por el nombre de la hoja que vas a utilizar para imprimir. Pon un botón en la hoja "impresion" y asigna el botón a la macro.
En al imagen veo que tienes una hoja por cada número de pedido. Entonces si quieres ejecutar la macro sobre cada hoja de pedido, cambia en la macro esta línea
Set h2 = Sheets("IMPRESION") 'hoja presentación para imprimirPor esta
Set h2 = Activesheet 'hoja presentación para imprimir
Entonces no crees el botón y ejecuta la macro sobre la hoja seleccionada.
La macro ya te pone el total, pero no pone el valor de "area".
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Hola Date, modifique lo que pusistes, pero me tira un error en esta parte y no se como solucionarlo. Saludos.
h2.Range("D18:E" & u).ClearContents
¿Qué mensaje de error te aparece?
¿Y qué modificaste en la macro?
Probe modificando esto y cambiando el nombre y no cambiandole el nombre a la solapa
Set h2 = Sheets("IMPRESION") 'hoja presentación para imprimirPor esta
Set h2 = Activesheet 'hoja presentación para imprimir
Borra esta línea de la macro
H2.Range("D18:E" & u). ClearContents.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Me sigue saliendo error, aun borrando eso,¿quieres que te envíe el archivo?
Te adjunto el archivo
https://drive.google.com/open?id=0B6KYK8RMoiIzUmlPSUF0NkhSQWM
No puedo descargar archivos.
El problema no es de la macro, si no de tus datos, en alguna celda no tienes números, o tienes texto o algún caracter con espacios.
Revisa bien tus datos.
Cambia esta línea
wtot = wtot + h1.Cells(b.Row, j)
Por esta:
wtot = wtot + val(h1.Cells(b.Row, j))
.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Ok, lo que pasa que en la hoja "INDICE CLT18" , en la fila S9 a BM9 tengo el encabezado de la tabla (datos alfanumericos) y debajo de eso tengo los datos que cargo, donde son datos numéricos y en muchas celdas al no tener datos están vacías. Entonces necesitaria que en la hoja "IMPRESION" la informacion que figura en el margen superior (horizontal) se vea reflejada en la columna D, posteriormente los datos que figuren debajo del margen superior deben aparecen reflejados en la celda E. Pero solo aquellos que contengan datos cargados.
Eso hace la macro, pero en tu primera imagen los encabezados están en la fila 13.
No importa si tienes números o vacías, el problema es si tienes letras.
Es difícil que la macro funcione si cambias los datos.
Ahora cambia esta línea de la macro
uc = h1. Cells(13, Columns. Count).End(xlToLeft). Column
Por esta
uc = h1. Cells(9, Columns. Count).End(xlToLeft). Column
Si no te funciona envíame tu archivo para revisarlo.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Mariano Andres Lopez”
Disculpa, tienes razón, agarre otro archivo donde cambiaron las filas. Te envío el archivo por email. Un abrazo.
Te anexo la macro actualizada
Sub Copiar_Valores()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("INDICE CLT18") 'hoja con datos
Set h2 = Sheets("IMPRESION") 'hoja presentación para imprimir
'
valor = h2.Range("F9")
If valor = "" Then
MsgBox "Introduce el dato a buscar"
Exit Sub
End If
'
Set b = h1.Columns("A").Find(valor, lookat:=xlWhole)
If Not b Is Nothing Then
'u = h2.Range("D" & Rows.Count).End(xlUp).Row
n = 18
wtot = 0
'If u < 18 Then u = 18
h2.Range("D18:E30").ClearContents
uc = h1.Cells(9, Columns.Count).End(xlToLeft).Column - 1
For j = Columns("S").Column To uc
If h1.Cells(b.Row, j) <> "" Then
h2.Cells(n, "D") = h1.Cells(9, j)
h2.Cells(n, "E") = h1.Cells(b.Row, j)
'wtot = wtot + h1.Cells(b.Row, j)
n = n + 1
End If
Next
'h2.Cells(n, "D") = "Total"
'h2.Cells(n, "E") = wtot
MsgBox "Fin"
Else
MsgBox "El dato no existe"
End If
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
