Buscar celdas no vacias en un rango y copiar datos en otra hoja

hola David

podrias hacer algo asi

Sub copiar2() 'Título de la macro
dim hj as worksheet
for each hj in thisworkbook.worksheets
x = 8 ' Variable inicial correspondiete a la primer fila
For Each celda In .Range("'1'!B5:B29") 'Rango que abarca las filas a
validar
If celda <> 0 Then 'Si la variable "celda" es diferente de cero
entonces
worksheets("Hoja32").Cells(x, 1) = celda 'Copia los valores
mayores a cero a la
columna 2
x = x + 1 ' Va copiando de 1 en 1 las celdas con valores
mayores a cero
End If 'Fin de la condición
Next 'Sigue para la siguiente celda el mismo proceso
next
End Sub

no te fies mucho, pero por ahi podrian andar los tiros

un saludo y hasta pronto
Ivan

disculpa David saca la variable del 1er bucle
Ivan ha escrito:

hola David

podrias hacer algo asi

Sub copiar2() 'Título de la macro
dim hj as worksheet

->>> x = 8 ' Variable inicial correspondiete a la primer fila

for each hj in thisworkbook.worksheets

For Each celda In .Range("'1'!B5:B29") 'Rango que abarca las filas a
validar
If celda <> 0 Then 'Si la variable "celda" es diferente de cero
entonces
worksheets("Hoja32").Cells(x, 1) = celda 'Copia los valores
mayores a cero a la
columna 2
x = x + 1 ' Va copiando de 1 en 1 las celdas con valores
mayores a cero
End If 'Fin de la condición
Next 'Sigue para la siguiente celda el mismo proceso
next
End Sub

no te fies mucho, pero por ahi podrian andar los tiros

un saludo y hasta pronto
Ivan

hola David, disculpa los otros dos mensajes y prueba a ver si te vale
este

OJO-> cambia "Hoja4" por el nombre de la hoja de destino, y si tienes
mas hojas que la s 31 y la de destino, tambien deberias indicarle que
no las copie ->

-> If hj.Name <> "Hoja4" and hj.Name <> "Hoja5" and .. Then (pej)

esta creo que si te valdria para lo que expones. Prueba con copias

Sub copiar3()
Dim hj As Worksheet, x As Long, celda As Range
x = 8
For Each hj In ThisWorkbook.Worksheets
If hj.Name <> "Hoja4" Then
With hj
For Each celda In .Range("b5:b29")
If celda <> 0 Then
Worksheets("Hoja4").Cells(x, 1) = celda
x = x + 1
End If
Next
End With
End If
Next
End Sub

espero que te sirva

un saludo y hasta pronto
Ivan

Ivan eres un monstruo! Funciona perfectamente. Ha sido un poco largo,
pero por fín casí lo he conseguido.

Digo lo de casí porque ahora tengo que volver a meter esta macro para
que me copie lo mismo pero en lugar de la columna A en la columna B de
la hoja TOTAL y buscando en el rango C5:C29 en lugar de en el rango
B5:B29 de cada una de las hojas.

A lo mejor es un poco lioso de explicar, si me dices a que dirección
te puedo enviar el archivo creo que lo verás mucho más claro.

Como ves en excel soy un paquete, pero puedes contar con mi ayuda y mis
recursos para lo que quieras relacionado con la música o el sector
inmobiliario.

Un saludo,

David.

hola David

no se si te he entendido bien, pero si lo que quieres es que el valor
que tienes en 'c' de las hojas de origen se copie a continuacion de su
correspondiente 'b' de origen en la hoja 32 (¿total?), creo que te
valdria con esto ->

''**********************************codigo 1*****************
Sub copiar3()
Dim hj As Worksheet, x As Long, celda As Range
x = 8
Worksheets("Hoja4").[a:a].Clear
For Each hj In ThisWorkbook.Worksheets
If hj.Name <> "Hoja4" Then
With hj
For Each celda In .Range("b5:b29")
If celda <> 0 And celda <> "" Then
With Worksheets("Hoja4")
.Cells(x, 1) = celda
''' añades esta sentencia ->
'''-> .Cells(x, 2) = celda.Offset(0, 1)
x = x + 1
End If
Next
End With
End If
Next
End Sub
''*************************************
por otro lado si el nombre de las hojas de origen es siempre "Hoja1",
Hoja2", etc, tambien podrias tambien hacer esto otro -> te he
añadido algunos comentarios, que puedes copiar con el codigo o
ekliminar si quieres, ojo a los saltos de linea

'''***************************codigo 2************
Sub copiar4()
Dim nhj As Byte, x As Long, celda As Range
x = 8

''este bloque with es opcional, si la 'Hoja32' siempre
'' es nueva puedes quitarlo, pero si usas algo
'' parecido a una plantilla no esta de mas dejarlo
'' si quieres variar la fila de inicio solo debes
'' cambiar el valor de x

With Worksheets("Hoja32") '''puedes cambiar "Hoja32" por otro
nombre
If .[b65536].End(xlUp).Row > x Then _
.Range("b" & x & ":b" & .[b65536].End(xlUp).Row).Clear
End With

''las hojas deben llamarse "Hoja1", "Hoja2",...,"Hoja32"
'' si no es asi te iria mejor el otro codigo

For nhj = 1 To 31
With Worksheets("Hoja" & nhj)
For Each celda In .Range("b5:b29")

''aparte de 0 comprueba que no este vacia ("")
''aunque uses otras formas (creo que) esto deberias incluirlo

If celda <> 0 And celda <> "" Then

With Worksheets("Hoja32")
.Cells(x, 1) = celda

''esto es valido si quieres que a la celda con datos de 'B' le
''corresponda su respectiva de 'C'(haya lo que haya en C)

.Cells(x, 2) = celda.Offset(0, 1)
End With
x = x + 1
End If
Next
End With
Next
End Sub
''********************************************
si no te vale o no es lo que buscas comentas, y, aunque no se cuando
podria mirartelo, (ni si mi capacidad da para mucho mas), si quieres me
mandas el archivo (comprimido en zip).

actualmente no tengo ni idea de como se ve mi correo, pero antes habia
que quitarle las kas (por cierto, si no te importa ¿me comentas
como/que se ve ?)

un saludo y hasta pronto
Ivan