Macro para copiar Valores de varias Pestañas a una Resumen
publicado
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"
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