Actualizar información consolidada

2 envíos / 0 nuevos
Último envío
kdgratzg@unal.edu.co
Imagen de kdgratzg@unal.edu.co
Offline
última acción: Hace 2 años 3 meses
alta: 23/11/2021 - 19:45
Puntos: 25
Actualizar información consolidada

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

Frank2021
Imagen de Frank2021
Offline
última acción: Hace 2 años 1 mes
alta: 04/11/2021 - 11:58
Puntos: 80
Solución

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