Copiar rango de celdas a otra hoja

[ulixes]

Hola, quisiera una ayuda con esta macro:

Sub copiarNuevo()

Dim hj As Worksheet, x As Long, celda As Range

x = 8

y = 0

For Each hj In ThisWorkbook.Worksheets

If hj.Name <> "Index" And hj.Name <> "Plantilla" And hj.Name <> "Consolidado" Then

If celda <> 0 Then

y = y + 1

With hj

For Each celda In .Range("v8:z48")

If celda <> 0 Then

Worksheets("Consolidado").Cells(y, x) = celda

x = x + 1

End If

Next

End With

End If

Next

End Sub

Lo que deberia hacer es recorrer todo el libro (menos las hojas indicadas), copiar las celdas ocupadas en el rango v8:z8, y pegarlas en otra hoja, fila tras fila.

El problema es que me pone un error de compilacion "Next sin for" en el ultimo next, y como no tengo idea de macros necesitaria alguien que la revise.

Logicamente muchas gracias.

[chkenshin]

lo mejor es que subas un libro de ejemplo para entender mejor tu solicitud.

por de pronto viendo tu codigo te falta cerrar un "if", debería de quedar así.

Sub copiarNuevo()
Dim hj As Worksheet, x As Long, celda As Range
x = 8
y = 0
For Each hj In ThisWorkbook.Worksheets
If hj.Name <> "Index" And hj.Name <> "Plantilla" And hj.Name <> "Consolidado" Then
If celda <> 0 Then
y = y + 1
With hj
For Each celda In .Range("v8:z48")
If celda <> 0 Then
Worksheets("Consolidado").Cells(y, x) = celda
x = x + 1
End If
Next
End With
End If
End If
Next
End Sub
[/PHP]

[ulixes]

Hola chkenshin, gracias por ocuparte.

La macro que vos me pones, produce "error 91 en tiempo de ejecucion - Variable de objeto o bloque with no establecido", y me marca esta linea:

If celda <> 0 Then

en el editor.

Ahi subo el archivo de ejemplo.

Ejemplo.rar

[ulixes]

Bueno, después de mucho andar lo he conseguido. Hice una especie de Frankenstein pero es a lo que llego por ahora.

Sub ActualizarTotales()

Dim i As Byte

Application.ScreenUpdating = False

ActiveSheet.Unprotect ("xxx")

Range("a3:e1000").ClearContents

For i = 5 To ThisWorkbook.Sheets.Count

ThisWorkbook.Sheets(i).Select

Range("V8:Z48").Select

Selection.Copy

Sheets("Consolidado").Select

Range("A65536").End(xlUp).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=True, Transpose:=False

Next

Range("A1").Select

ActiveSheet.Protect ("xxx")

Application.ScreenUpdating = True

End Sub

Ahora bien, si alguien pudiera echarle un vistazo pulirla lo agradecería.

Los detalles que le faltan son:

*Después de copiar y pegar todo, queda seleccionado (no activo) el rango v8:z48 de las hojas desde donde copio.

*El otro detalle es el tiempo que demora, teniendo en cuenta que trabaja con mas de 100 hojas. Supongo que esto se puede deber a que la macro copia todo el rango y no solo las filas con datos, pero ya eso no se como hacerlo.

Muchas gracias.