Capturar información de varias hojas en una nueva

Estoy tratando de automatizar la captura de información a partir de varias hojas de un mismo libro de excel, una vez grabada la macro esta solo me efectúa el proceso hasta la hoja 4 del libro y en total son 287 hojas.

Que sentencia debo incluir al código para iterar el proceso hasta la ultima hoja.?

Gracias!

Este es el código actual:

Sub pestanas()
'
' Pestanas Macro
'
'
Sheets("Hallazgo1").Select
Range("G5:R5").Select
Selection.Copy
Sheets("Hoja1").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Hallazgo2").Select
Range("G5:R5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Hoja1").Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Hallazgo3").Select
Range("G5:R5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Hoja1").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Hallazgo4").Select
ActiveWindow.ScrollRow = 11
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 8
ActiveWindow.ScrollRow = 7
ActiveWindow.ScrollRow = 6
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 1
Range("G5:R5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Hoja1").Select
Range("A5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E15").Select
End Sub

Respuesta
2

Te adjunto la macro para conseguirlo:

sub proceso()
'por luismondelo
for each hoja in sheets
if ucase(hoja.name) <>"HOJA1" then
hoja.select
range("g5:r5").copy
sheets("hoja1").range("a65000").end(xlup).offset(1,0).pastespecial paste:=xlvalues
end if
next
end sub

recuerda valorar la respuesta

Hola!

Gracias por la pronta respuesta. La macro se ha ejecutado pero no hasta el final supongo que los rangos de algunas de las hojas son diferentes y por tanto no pudo capturar aquellos datos fuera del rango g5:r5. Tienes alguna Recomendación Para este problema.?

La macro está preparada para recorrer todas las hojas del libro. ¿Pudiera ser que tuvieras alguna pestaña oculta?

¿Puede ser que algunas celdas estén combinadas?

Buen Día!!

Si, Debo preparar la data para ejecutar el proceso sin inconvenientes, gracias por las sugerencias. 

Qué sintaxys debo agregar al código para que me repita el proceso y capture informacion en la columna b, c, d....n

Hola!

Ya he solucionado la pregunta anterior solo era copiar la misma línea y cambiar la columna de destino...

Ahora quisiera saber si es posible meter un "or" en el rango de captura es decir me encuentro que los datos están en el rango g5:r5 y en ocasiones en el rango h5:r5

Prueba con la macro así:

sub proceso()
'por luismondelo
for each hoja in sheets
if ucase(hoja.name) <>"HOJA1" then
hoja.select
if range("h5").value <>"" then
range("h5:h5").copy
sheets("hoja1").range("a65000").end(xlup).offset(1,0).pastespecial paste:=xlvalues
else
range("g5:r5").copy
sheets("hoja1").range("a65000").end(xlup).offset(1,0).pastespecial paste:=xlvalues
end if
next
end sub

¡Gracias! 

Buen día Luis!

Mira me he encontrado con que algunos de los rangos están vacíos y deseo que para estas casillas vacías me muestre que no registra "N.R" ... intenté (basada en tu código) agregándole un if, pero no me ha resultado:

sub proceso()
'por luismondelo
for each hoja in sheets
if ucase(hoja.name) <>"HOJA1" then
hoja.select
if range("h5").value <>"" then
range("h5:h5").copy
sheets("hoja1").range("a65000").end(xlup).offset(1,0).pastespecial paste:=xlvalues
else
if range("h5").value ="" then
print 'N.R'
else
range("g5:r5").copy
sheets("hoja1").range("a65000").end(xlup).offset(1,0).pastespecial paste:=xlvalues
end if
next
end sub

¿Dónde quieres pintar esas siglas?

Hola!

En la misma columna a. Sucede que al correr la iteración; si encuentra un rango sin información, este no me reporta que aquel rango de esa hoja no tiene datos o está en blanco...

Gracias Mil!

("a65000")

Prueba ahora con este código para el tema de los rangos vacios

sub proceso()
'por luismondelo
c=0
for each hoja in sheets
if ucase(hoja.name) <>"HOJA1" then
hoja.select
if range("h5").value <>"" then
range("h5:h5").copy
sheets("hoja1").range("a65000").end(xlup).offset(1,0).pastespecial paste:=xlvalues
c=1
end if
if range("g5").value <>"" then
range("g5:r5").copy
sheets("hoja1").range("a65000").end(xlup).offset(1,0).pastespecial paste:=xlvalues
c=1
end if
if c=0 then
sheets("hoja1").range("a65000").end(xlup).offset(1,0).value = "N.R"
end if
end if
c=0
next
end sub

Buen Día. Muchas Gracias por tu colaboración!!

Probé la opción de código anterior pero se duplicaron los registros. Encontré una función "IsEmpty"  pero no sé como adaptarla al código. Esto va así:

Sub Extraccion()
'
' Extraccion Macro
'
'
For Each hoja In Sheets
If UCase(hoja.Name) <> "HOJA1" Then
hoja.Select
If Range("h5").Value <> "" Then
Range("h5:r5").Copy
Sheets("hoja1").Range("a65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Else
Range("h5:u5").Copy
Sheets("hoja1").Range("a65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End If
If Range("h6").Value <> "" Then
Range("h6:j6").Copy
Sheets("hoja1").Range("b65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Else
Range("h6:m6").Copy
Sheets("hoja1").Range("b65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End If
If Range("h7").Value <> "" Then
Range("h7:j7").Copy
Sheets("hoja1").Range("c65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Else
Range("h7:m7").Copy
Sheets("hoja1").Range("c65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End If
If Range("q6").Value <> "" Then
Range("q6:u6").Copy
Sheets("hoja1").Range("d65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Else
Range("n6:r6").Copy
Sheets("hoja1").Range("d65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End If
If Range("q7").Value <> "" Then
Range("q7:u7").Copy
Sheets("hoja1").Range("e65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Else
Range("n7:r7").Copy
Sheets("hoja1").Range("e65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End If
If Range("w6").Value <> "" Then
Range("w6:z6").Copy
Sheets("hoja1").Range("f65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Else
Range("z6:ac6").Copy
Sheets("hoja1").Range("f65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End If
If Range("w7").Value <> "" Then
Range("w7:z7").Copy
Sheets("hoja1").Range("g65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Else
Range("z7:ac7").Copy
Sheets("hoja1").Range("g65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End If
If Range("ag6").Value <> "" Then
Range("ag6:ai6").Copy
Sheets("hoja1").Range("h65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Else
Range("ad6:af6").Copy
Sheets("hoja1").Range("h65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End If
If Range("ag7").Value <> "" Then
Range("ag7:ai7").Copy
Sheets("hoja1").Range("i65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Else
Range("ad7:af7").Copy
Sheets("hoja1").Range("i65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End If
If Range("v4").Value <> "" Then
Range("v4:af4").Copy
Sheets("hoja1").Range("j65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Else
If Range("aa4").Value <> "" Then
Range("aa4:ai4").Copy
Sheets("hoja1").Range("j65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Else
Range("y4:ai4").Copy
Sheets("hoja1").Range("j65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End If
End If
If Range("b10").Value <> "" Then
Range("b10:ai10").Copy
Sheets("hoja1").Range("k65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
Else
Range("b12:af12").Copy
Sheets("hoja1").Range("k65000").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlValues
End If
End If
Next
End Sub

La función isempty es lo mismo que lo que he hecho yo con la línea

<>""

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Juntar información en una sola hoja

Espero que me puedan ayudar con una macro que permita juntar la información de 6 hojas que tengo en una sola hoja teniendo en cuenta que la información de cada hojapuede cambiar en cantidades, el formato que utilizo es una base de datos en 2003,...
1 respuesta

Necesito una macro para copiar varias celdas a una hoja resumen colocándolas una debajo de la otra

Tengo una hoja resumen (Hoja1) y una serie de hojas de datos, no siempre son el mismo número. Los nombres de las hojas de datos van desde el 1 en adelante. En la hoja resumen quiero copiar las celdas a5, d12 y d15 de cada hoja de datos y que se me...
1 respuesta

Filtrar y buscar valores con macros excel

Amigos, espero me puedan ayudar con esto, Tengo que crear una macros en Excel que busque un valor y me traiga la fila que solo tiene valores y su encabezado. Ej: Tengo una Hoja de nombre “J” en ella se encuentra todos los datos, en la columna A los...
2 respuestas

Extraer filas excel (con condición) en otra hoja del libro...

Tengo una tabla a7 a n1000 llena de datos. A b c d e g ........n 7 nombre dirección situación articulo fabrica precio ... N Y quisiera extraer en hoja2 las filas que en la columna c "situación" ponga "ok" eliminándolas de la tabla de la hoja 1 y...
1 respuesta

¿Cómo hago una macro en excel para copiar todos los datos d varias hojas a una nueva?

Tengo 5 hojas en un libro de excel 2003, necesito pasar con una macro todos los datos de 3 de las hojas a una nueva hoja, pero poniendo todos los datos uno debajo del otro a partir de la fila 2 porque la fila 1 son los títulos de las columnas. (Las...
2 respuestas

Macro buscar y recopilar datos en Excel

Tengo un botón en una la Hoja1 de Excel e información en esta misma hoja de los rangos (A5:F100), en la columna A del rango (A1:A100) tengo un numero 0 (cero) o también el numero 1 (uno), lo que necesito es que al momento de oprimir el botón me...
2 respuestas

Copiar una fila en otra hoja si cumple condición

Tengo excel con 10 hojas, una por cada deposito de vino, las cantidades se mueven de un deposito a otro, como hacer que haga una salida del deposito 1 al 5 por ejemplo y automáticamente en la hoja del deposito 5 aparezca ese movimiento con su suma o...
1 respuesta

Macro para informes diarios

Tengo una tabla (la hoja se llama VENTAS ACTIVIDADES), con todas las actividades que voy vendiendo, esta tabla tiene 19 columnas(Fecha de actividad, Hora, Actividad, Nombre del cliente, Tlf...). Aquí almaceno todos los datos de las actividades que...
3 respuestas

Macro para guardar información de hoja1 a hoja2 con fecha. Excel

Espero que me puedan ayudar, normalmente imprimo todos los días hojas en excel, podrían ayudarme en un macro para poder guardalo en la siguiente hoja, correlativo uno debajo de otro y ordenados por fecha. El formato que relleno datos es de 5 columnas...
1 respuesta

Buscar dato, copiar rango y pegar traspuesto

Dios les bendiga, primero que todo saludar a todos los expertos que han sido de gran ayuda en mi proceso de formación laboral y agradecer a todoexpertos por crear esta pagina la cual ha sido de mucha ayuda. Tengo un libro compuesto por dos hojas...
1 respuesta