Hola buenos días,
estoy utilizando una macro para consolidar la información de distintas hojas del mismo libro, sin embargo no sé como actualizar la información sin que se repita la parte copiada anteriormente pues toma en cuenta la última linea vacia, es más un codigo para consolidar una sola vez y necesoto que se actualice cada vez que se active la macro. Les dejo el codigo, agradezco la ayuda.
Sub Agruparhojas()
Dim Cuenta As Integer
Dim I As Integer
Dim J As Integer
Dim MsgContinuar As Boolean
MsgContinuar = MsgBox("Se agruparan los datos" + _
vbNewLine + vbNewLine + "Desea continuar?", vbYesNo + vbQuestion, "EXCELeINFO")
If MsgContinuar = vbNo Then Exit Sub
Cuenta = Sheets.Count
For I = 3 To Cuenta
If Sheets(I).Name <> "Contenido" And Sheets(I).Name <> "prueba" Then
Sheets(I).Activate
Sheets(I).Range("A2").Select
ActiveCell.CurrentRegion.Offset(1, 0).Resize(ActiveCell.CurrentRegion.Rows.Count - 1, _
ActiveCell.CurrentRegion.Columns.Count).Select
Selection.Copy
Sheets(2).Activate
Range("A2").Select
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
ActiveSheet.Paste
Selection.End(xlDown).Select
Selection.Offset(1, 0).Select
Else
'Nada
End If
Next I
Application.CutCopyMode = False
Call activarA2
Sheets(2).Name = "Consolidado"
End Sub
Hola,
aquí tienes mi propuesta. Espero que te sirva.
Sub Agruparhojas()
'-- Preguntar. MsgContinuar es de tipo Integer, no puede ser Boolean
Dim MsgContinuar As Integer
MsgContinuar = MsgBox("Se agruparan los datos" + vbNewLine + vbNewLine + "Desea continuar?", vbYesNo + vbQuestion, "EXCELeINFO")
'-- Si es No, finalizar
If MsgContinuar = vbNo Then
Exit Sub
End If
'-- A2 tiene las cabeceras, por ello empezamos en A3
Dim rOrigen As Range
Set rOrigen = Sheets(2).Range("A3")
'-- Limpiamos el acumulado anterior
Dim rr As Long
rr = rOrigen.CurrentRegion.Rows.Count
rOrigen.CurrentRegion.Resize(rr - 1).Offset(1, 0).Cells.Clear
'-- Numero de hojas en el libro
Dim NumeroHojas As Integer
NumeroHojas = Sheets.Count
'-- Procesar hoja a hoja
Dim i As Integer
For i = 3 To NumeroHojas
If Sheets(i).Name <> "Contenido" And Sheets(i).Name <> "prueba" Then
'-- calcular el origen
Dim r As Range
Set r = Sheets(i).Range("A2").CurrentRegion
Dim s As Range '-- s = source
Set s = r.Offset(1, 0).Resize(r.Rows.Count - 1, r.CurrentRegion.Columns.Count)
'-- calcular el destino
Dim t As Range '-- t = target
Set t = rOrigen.Offset(Application.Rows.Count - rOrigen.Row).End(xlUp).Offset(1)
'-- Copiar los datos. No hace falta ganar el foco con Activate
s.Copy t
Else
'-- Nada
End If
Next i
End Sub