Macro para buscar, copiar, pegar

[JoseLinares]

Estimados amigos:

Hace pocos días tuve una consulta a este mismo foro debido a un proyecto que estoy realizando en mi trabajo. Solicité apoyo para poder hacer una búsqueda en todas las hojas de un libro a partir de una celda de la hoja "RESUMEN DEL DIA". El respetado forista/moderador JOSHUA me ayudó muy gentilmente y me dio el código VBA (abajo) para el esquema que pasé como ejemplo (ver adjunto "Libro2"). He querido "amoldar" dicho código (líneas abajo) a mi proyecto real (adjunto "Pruebai") y ahora no puedo.

Sub Resumen_Dia()
Dim n As Rangefecha = Sheets("RESUMEN DEL DIA").Range("B3")For i = 2 To Sheets.CountX = Sheets("RESUMEN DEL DIA").Range("A65536").End(xlUp).Row + 1With Sheets(i)Y = .Range("A65536").End(xlUp).Row.Range("A1:M" & Y).AutoFilter Field:=1, Criteria1:= _fecha, Operator:=xlAndVerificar = WorksheetFunction.Subtotal(3, .Range("A1:A" & Y))If Verificar > 1 Then.Range("A2:K" & Y).SpecialCells(xlCellTypeVisible).Copy _Destination:=Sheets("RESUMEN DEL DIA").Range("A" & X)End If.Range("A1").AutoFilterEnd WithNext

End Sub[/PHP]

Resumiendo:

- Tengo la hoja "RESUMEN DEL DIA", celda B3: "fecha". Al ejecutar la macro hace una búsqueda en todas las hojas del libro y copia y pega la fila donde esté el dato igual a "fecha", en la hoja "RESUMEN DEL DIA".

- Copia, pega y sigue la búsqueda en las siguientes hojas. De encontrar el dato buscado copia y pega en la hoja resumen después de última fila.

Lamentablemente no puedo abrir un tema ya cerrado, por lo que vuelvo a plantear mi pregunta, para las correcciones respectivas.

Desde ya, gracias a Joshua y a todos por el apoyo.

Saludos,

José.

Pruebai.rar

Libro2.rar

[joshua]

Saludos.

La macro seria la siguiente:

Sub Resumen_Dia()
Dim n As Range
fecha = Sheets("RESUMEN DEL DIA").Range("B3")
For i = 2 To Sheets.Count
X = Sheets("RESUMEN DEL DIA").Range("A65536").End(xlUp).Row + 1
With Sheets(i)
Y = .Range("A65536").End(xlUp).Row
.Range("A10:A" & Y).AutoFilter Field:=1, Criteria1:=fecha, Operator:=xlAnd
Verificar = WorksheetFunction.Subtotal(3, .Range("A10:A" & Y))
If Verificar > 1 Then
.Range("A11:M" & Y).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Sheets("RESUMEN DEL DIA").Range("A" & X)
End If
.Range("A10").AutoFilter
End With
Next
End Sub[/PHP]

Prueba y comentas.

Atte.

joshua

[JoseLinares]

Estimado Joshua,

No he podido correr la macro. Me sale un mensaje de errror.

La depuración se dirige a: ".Range("A10:A" & Y).AutoFilter Field:=1, Criteria1:=fecha, Operator:=xlAnd".

A ti te corrió normal?

Saludos y gracias por tu gentil apoyo,

José

[joshua]

Saludos.

Ami me corre bien la macro, prueba el adjunto y comentas.

Atte.

joshua

Pruebai_joshua10052012.rar

[JoseLinares]

Gracias por tu apoyo, Joshua.

Veo tu prueba y funciona perfecto, pero en mi trabajo real persiste el mismo problema. Ahora, te comento que mi archivo consiste en varias hojas, muchas de ellas son copias de la una misma pestaña ("Trabajador"), pero con datos cambiados. Ahora bien, en esta hoja tengo muchos otros botones y macros (quizás esto sea el problema??). Además, otro posible problema sea que en mi archivo, si bien el 99% son copias de la pestaña "Trabajador", tengo un 1% que son hojas con formatos diferente. Quizás esto también sea causa del problema?

Me encantaría pasarte mi archivo, pero creo que no es posible enviar archivo con macros por este medio?

Un abrazo,

José.

[JoseLinares]

Estimado Joshua,

Pude finalmente subir el archivo. Esto te dará mayor luz a mi consulta.

Mil gracias,

José

16.04(4).rar

[JoseLinares]

Estimados:

Alguna novedad?

Mucho apreciaré su ayuda.

Gracias,

José.