Macro para copiar Valores de varias Pestañas a una Resumen

[Vimepas]

Hola a todos,

Soy bastante nuevo con el tema de macros y no consigo que la macro que os copio abajo me pegue solo valores.

Se trata de crear una Pestaña Resumen en un libro que va recopilando datos de varias pestañas y poder ir actualizando esta información (estas pestañas están formuladas en base a otras pestañas ocultas para conseguir mantener la misma estructura)

Muchas gracias por adelantado por vuestra ayuda.

Saludos

Sub pasar_datos_resumen()

Application.ScreenUpdating = False

origen = ActiveSheet.Name

linea = 2

destino = "BBDD GENERAL"

Sheets(destino).Activate

With Sheets(destino).Range("A2:A65000")

Set hasta = .Find("")

limite = hasta.Row

Rows("2:" & limite).Delete

End With

For Each pestaña In Worksheets

If pestaña.Name = destino Then GoTo otra:

pestaña.Activate

For Each titulo In Range("b3:b40000")

If titulo = "" Then GoTo otra:

If titulo = "1" Then

titulo.EntireRow.Columns("B:P").Copy

Sheets(destino).Range("b" & linea).PasteSpecial

Application.CutCopyMode = False

linea = linea + 1

registro = registro + 1

End If

Next titulo

otra:

Next pestaña

Sheets(destino).Activate

Range("a1").Select

Sheets(origen).Activate

Application.ScreenUpdating = True

MsgBox "Se ha completado la información de la BBDD General." & Chr(10) & Chr(10) & " Se han incluido - " & registro & " - registros.", vbInformation, "Fin del proceso"

End Sub

Ejemplo Macros.zip

[Antoni]

Hola:

Creo que es esto:

Sub pasar_datos_resumenMA()

Dim Destino As Worksheet, Pestaña As Worksheet, Fila As Long


Application.ScreenUpdating = False

Set Destino = Sheets("BBDD GENERAL")


Destino.Rows("2:" & Destino.Range("B" & Rows.Count).End(xlUp).Row).Delete


Fila = 2

For Each Pestaña In Worksheets

   If Not Pestaña.Name = Destino.Name And _

      Pestaña.Name Like "BBDD*" Then

      For x = 3 To Pestaña.Range("B" & Rows.Count).End(xlUp).Row

         If Pestaña.Range("B" & x) = "1" Then

            Pestaña.Range("B" & x & "" & x).Copy

            Destino.Range("B" & Fila).PasteSpecial [B]Paste:=xlValues[/B]

            Application.CutCopyMode = False

            Fila = Fila + 1

         End If

      Next

   End If

Next


Destino.Activate

Destino.Range("B2").Select

Application.ScreenUpdating = True

MsgBox "Se ha completado la información de la BBDD General." & Chr(10) & Chr(10) & _

       " Se han incluido - " & Fila - 2 & " - registros.", vbInformation, "Fin del proceso"


End Sub

[/CODE]

[Vimepas]

Mucha Gracias!!!

Funciona Perfectamente!!:applouse:

- - - - - Mensaje combinado - - - - -

Hola de nuevo MacroA.

Ahora mismo esta Macro esta enfocada para analizar información en un Archivo mensual, pero sería posible que cuándo se ejecutase la MACRO copiara la nueva información a partir de la última fila donde hayan datos?asi podría ir analizando la evolución de los datos con una dinámica. debería incluir la función LastRow?

gracias de nuevo por tu ayuda.

- - - - - Mensaje combinado - - - - -

Hola de nuevo MacroA.

Ahora mismo esta Macro esta enfocada para analizar información en un Archivo mensual, pero sería posible que cuándo se ejecutase la MACRO copiara la nueva información a partir de la última fila donde hayan datos?asi podría ir analizando la evolución de los datos con una dinámica. debería incluir la función LastRow?

gracias de nuevo por tu ayuda.