Conectar datos externos en excel y dividir en hojas según valor

A tod@s,

Gracias por la ayuda que prestáis,

Tengo un libro conectado a otro mediante la conexión de datos externos, en el libro donde se vuelcan los datos me gustaría dividir en hojas según el valor de una columna, teniendo:

Hoja General (aquí se vuelcan los datos de otro libro)

Hoja1 (Filtrada por "pepe"de la general columna "usuario")

Hoja2 (Filtrada por "antonio" de la general columna "usuario")

Etc

La conexión de datos la he configurado para que se actualice al abrir el archivo pero esto no sé si funcionará para que los filtros de las hojas también se actualicen. ¿Alguna idea?

1 respuesta

Respuesta
1

Si tienes una macro en el evento open de tu libro, algo como esto:

Private Sub Workbook_Open()
    ActiveWorkbook.RefreshAll
End Sub

Agrega al final de tu macro la siguiente línea, quedaría así:

Private Sub Workbook_Open()
    ActiveWorkbook.RefreshAll
    DividirHojas
End Sub

Ahora agrega la siguiente macro a un módulo, ajusta en la macro en las siguientes líneas, el nombre de la hoja y la columna de usuario, yo puse la "B", debes poner la columna correcta.

Set h1 = Sheets("General") 'Nombre de la hoja
c = "B" 'Columna usuario

En la siguiente línea de la macro debes poner la letra de última columna con datos, yo puse la Z, pero tu debes poner la columna correcta.

.SetRange h1.Range("A1:Z" & u): .Header = xlYes: .Apply

Te anexo la macro, recuerda realizar los cambios:

Sub DividirHojas()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("General") 'Nombre de la hoja
    c = "B"                    'Columna usuario
    '
    u = h1.Range(c & Rows.Count).End(xlUp).Row
    With h1.Sort
     .SortFields.Clear: .SortFields.Add Key:=h1.Range(c & "2:" & c & u)
     .SetRange h1.Range("A1:Z" & u): .Header = xlYes: .Apply
    End With
    '
    ant = h1.Cells(2, c)
    Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
    j = 2
    For i = 2 To u
        If ant <> h1.Cells(i, c) Then
            Set h2 = Sheets.Add(after:=Sheets(Sheets.Count))
            j = 2
        End If
        h1.Rows(i).Copy h2.Rows(j)
        j = j + 1
        ant = h1.Cells(i, c)
    Next
End Sub

¡Gracias! Eso es la leche :P

Recuerda cambiar la valoración de la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas