Hoja de Excel dividida en varios archivos basándose en la columna Uso de VBA
¿Tiene un big data en una hoja de Excel y necesita distribuir esa hoja en varias hojas, según algunos datos en una columna? Esta tarea muy básica pero requiere mucho tiempo.
Por ejemplo, tengo estos datos. Estos datos tienen una columna denominada Fecha, Escritor y Título. La columna del escritor tiene el nombre del escritor del título respectivo. Quiero obtener los datos de cada escritor en hojas separadas.
Para hacer esto manualmente, tengo que hacer lo siguiente:
-
Filtrar un nombre. Copie los datos filtrados. Agrega una hoja. Pega los datos. Cambie el nombre de la hoja. Repita los 5 pasos anteriores para cada uno.
En este ejemplo, solo tengo tres nombres. Imagínese si tuviera cientos de nombres.
¿Cómo dividiría los datos en diferentes hojas? Tomará mucho tiempo y también te agotará.
Para automatizar el proceso anterior de dividir una hoja en varias hojas, siga estos pasos.
Presione Alt + F11. Esto abrirá VB Editor para Excel Agregar un nuevo módulo * Copiar debajo del código en el módulo.
Sub SplitIntoSheets()
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
ThisWorkbook.Activate
Sheet1.Activate
'clearing filter if any
On Error Resume Next
Sheet1.ShowAllData
On Error GoTo 0
Dim lsrClm As Long
Dim lstRow As Long
'counting last used row
lstRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim uniques As Range
Dim clm As String, clmNo As Long
On Error GoTo handler
clm = Application.InputBox("From which column you want create files" & vbCrLf & "E.g. A,B,C,AB,ZA etc.")
clmNo = Range(clm & "1").Column
Set uniques = Range(clm & "2:" & clm & lstRow)
'Calling Remove Duplicates to Get Unique Names
Set uniques = RemoveDuplicates(uniques)
Call CreateSheets(uniques, clmNo)
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.AlertBeforeOverwriting = True
.Calculation = xlCalculationAutomatic
End With
Sheet1.Activate
MsgBox "Well Done!"
Exit Sub
Data.ShowAllData
handler:
With Application
.ScreenUpdating = True
.DisplayAlerts = True
.AlertBeforeOverwriting = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Function RemoveDuplicates(uniques As Range) As Range
ThisWorkbook.Activate
Sheets.Add
On Error Resume Next
ActiveSheet.Name = "uniques"
Sheets("uniques").Activate
On Error GoTo 0
uniques.Copy
Cells(2, 1).Activate
ActiveCell.PasteSpecial xlPasteValues
Range("A1").Value = "uniques"
Dim lstRow As Long
lstRow = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:A" & lstRow).Select
ActiveSheet.Range(Selection.Address).RemoveDuplicates Columns:=1, Header:=xlNo
lstRow = Cells(Rows.Count, 1).End(xlUp).Row
Set RemoveDuplicates = Range("A2:A" & lstRow)
End Function
Sub CreateSheets(uniques As Range, clmNo As Long)
Dim lstClm As Long
Dim lstRow As Long
For Each unique In uniques
Sheet1.Activate
lstRow = Cells(Rows.Count, 1).End(xlUp).Row
lstClm = Cells(1, Columns.Count).End(xlToLeft).Column
Dim dataSet As Range
Set dataSet = Range(Cells(1, 1), Cells(lstRow, lstClm))
dataSet.AutoFilter field:=clmNo, Criteria1:=unique.Value
lstRow = Cells(Rows.Count, 1).End(xlUp).Row
lstClm = Cells(1, Columns.Count).End(xlToLeft).Column
Debug.Print lstRow; lstClm
Set dataSet = Range(Cells(1, 1), Cells(lstRow, lstClm))
dataSet.Copy
Sheets.Add
ActiveSheet.Name = unique.Value2
ActiveCell.PasteSpecial xlPasteAll
Next unique
End Sub
Cuando ejecute el procedimiento SplitIntoSheets (), la hoja se dividirá en varias hojas, según la columna dada. Puede agregar un botón en la hoja y asignarle esta macro.
Cómo funciona
El código anterior tiene dos procedimientos y una función. Dos procedimientos son SplitIntoSheets (), CreateSheets (únicos como rango, clmNo como largo) y una función es Eliminar duplicados (únicos como rango) como rango. El primer procedimiento es SplitIntoSheets (). Este es el procedimiento principal. Este procedimiento establece las variables y RemoveDuplicates para obtener nombres únicos de la columna dada y luego pasa esos nombres a CreateSheets para crear hojas.
RemoveDuplicates toma un argumento que es rango que contiene nombre.
Elimina los duplicados de ellos y devuelve un objeto de rango que contiene nombres únicos.
Ahora se llama CreateSheets. Se necesitan dos argumentos. Primero los nombres únicos y segundo la columna no. a partir de los cuales se ajustarán los datos. Ahora CreateSheets toma cada nombre de los únicos y filtra el número de columna dado por cada nombre. Copia los datos filtrados, agrega una hoja y pega los datos allí. Y sus datos se dividen en diferentes hojas en segundos.
Puedes descargar el archivo aquí.
Dividir en hojas
Cómo utilizar el archivo:
-
Copie sus datos en Sheet1. Asegúrese de que comience desde A1.
Haga clic en el botón Dividir en hojas * Ingrese la letra de la columna de la que desea dividir. Haga clic en Aceptar.
-
Verá un mensaje como este. Tu hoja está dividida.
Espero que el artículo sobre la división de datos en hojas separadas le haya resultado útil. Si tiene alguna duda sobre esta o sobre cualquier otra característica de Excel, no dude en preguntar en la sección de comentarios a continuación.