Copiar rango v8:z48 de todas las hojas a una hoja resumen

Hola, tengo esta macro que me copia todo el rango v8:v48, pero necesitaría que ese rango se extienda a v8:Z8

Sub copiar()
Dim hj As Worksheet, x As Long, celda As Range
x = 8
For Each hj In ThisWorkbook.Worksheets
If hj.Name <> "Hoja5" And hj.Name <> "Index" And hj.Name <> "Plantilla" And hj.Name <> "Consolidado" And hj.Name <> "Consolidado2" And hj.Name <> "Base" Then
With hj
For Each celda In .Range("v8:v48")
If celda <> 0 Then
Worksheets("Hoja5").Cells(x, 1) = celda
x = x + 1
End If
Next
End With
End If
Next
End Sub

La idea es que la macro me copie la tabla que tengo en ese rango en todas las hojas y me las pegue en la hoja5.

Tengo que cambiar de macro o con alguna modificación bastara? No tengo mucha idea de macros, asique cualquier ayuda que me puedan dar la agradecería.

1 Respuesta

Respuesta
1

Cambia la linea:

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

por esta otra:

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

Hola duainsulch, gracias por la atención.

Esa modificación funciona, (entre tantas cosas que he probado ya no recordaba que había intentado esa modificación) pero me copia la fila v8:z8 en la columna a8:a12, es decir verticlamente. Podría ser que la copie a la nueva hoja en forma horizontal?

Sucede que son demasiadas hojas las que tengo que copiar y aparte necesito trabajar sobre ese resumen, y expuesta toda la info en una sola columna se me hace muy difícil.

Reitero el agradecimiento y la atención.

Sub copiar()
Dim hj As Worksheet, x As Long, celda As Range
x = 8

y = 0
For Each hj In ThisWorkbook.Worksheets
If hj.Name <> "Hoja5" And hj.Name <> "Index" And hj.Name <> "Plantilla" And hj.Name <> "Consolidado" And hj.Name <> "Consolidado2" And hj.Name <> "Base" Then

If celda <> 0 Then y = y + 1
With hj
For Each celda In .Range("v8:z48")
If celda <> 0 Then
Worksheets("Hoja5").Cells(y, x) = celda
x = x + 1
End If
Next
End With
End If
Next
End Sub

Esta sin probar, mira si funciona

Aparece un error de compilación en el último Next (Next sin For)

Después de la linea

if celda...

añade la linea:

end if

Igual es eso

Ahora pone ·"Error 91 en tiempo de ejecución. Variable de objeto o bloque with no establecido, para la linea "If celda..."

Sub copiar()

Dim Hj As Worksheet
Dim X As Long
Dim Celda As Range
Dim Y As Long
X = 8
Y = 0
For Each Hj In ThisWorkbook.Worksheets
If Hj.Name <> "Hoja5" And Hj.Name <> "Index" And Hj.Name <> "Plantilla" And Hj.Name <> "Consolidado" And Hj.Name <> "Consolidado2" And Hj.Name <> "Base" Then
Y = Y + 1
With Hj
For Each Celda In .Range("v8:z48")
If Not Celda Is Nothing Then
Worksheets("Hoja5").Cells(Y, X) = Celda
X = X + 1
End If
Next
End With
End If
Next

end sub

Quizá haya algo mal en la macro, tal vez no sirva para lo que yo quiero.

Cuando solo tengo que copiar de una hoja, los datos me los copia de la siguiente manera:

hoja origen: v8 w8 x8 y8 z8

v9 w9 x9 y9 z9

hoja destino: v8 w8 x8 y8 z8 v9 w9 x9 y9 z9

es decir todas las celdas del rango pero en una sola fila.

Y si tengo mas de una hoja para copiar, solamente copia de la primera y se detiene.

Lo que precisaría es que esta macro me copie todas las filas con datos del rango v8:z48 (de todas las hojas, menos las indicadas) en la hoja5, creando asi una tabla con el total.

Espero que puedas entenderme, y si crees que la macro no me servirá me avises asi busco otra solución posible.

Desde ya muchas gracias.

Quieres copiar el rango exactamente igual que como esta en la hoja de origen o quieres eliminar los espacios en blanco en caso de que haya alguna celda vacía en el rango?

Porque sería mucho mas sencillo copiar el rango del tirón en lugar de hacer un bucle que copie celda a celda

Lo ideal seria que solo copie las filas que tienen datos, porque las hojas de las que se van copiar los datos son muchas y si no elimino los espacios en blanco la tabla total se haría muy larga. Pero tampoco quiero complicarte a vos ni hacerte perder mas el tiempo, si puedo copiar el rango entero ya después busco la manera de poder presentar los datos con mas claridad.

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 ("elsubte")
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 ("elsubte")
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.

Tal vez te podría funcionar algo así, para ganar en velocidad debes eliminar todos los select del código, que por otro lado no son necesarios en absoluto y su uso no es nada recomendable en bucles.

Para que no quede seleccionado nada después de haber copiado o cortado usa la instrucción

Application.CutCopyMode = False

Saludos

Sub ActualizarTotales()
Dim i As Byte
Application.ScreenUpdating = False
ActiveSheet.Unprotect ("elsubte")
Range("a3:e1000").ClearContents
For i = 5 To ThisWorkbook.Sheets.Count
ThisWorkbook.Sheets(i).Range("V8:Z48").Copy _

destination:= sheets("Consolidado").Range("A65536").End(xlUp).Offset(1, 0)
Next
Range("A1").Select

Application.CutCopyMode = False
ActiveSheet.Protect ("elsubte")
Application.ScreenUpdating = True
End Sub

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas