¿Tiene un big data en una hoja de Excel y necesita distribuir esa hoja en varias hojas, en función de algunos datos en una columna? Esta tarea muy básica pero requiere mucho tiempo.
Por ejemplo, tengo estos datos. Estos datos tienen una columna llamada 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
- Copiar los datos filtrados
- Agregar una hoja
- Pegar los datos
- Cambiar 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
- Copie el código siguiente en el módulo.
Sub SplitIntoSheets () Con la aplicación .ScreenUpdating = False .DisplayAlerts = False End With ThisWorkbook.Activate Sheet1.Activate 'borrar el filtro si hay alguno En caso de error Reanudar la siguiente hoja1.ShowAllData On Error GoTo 0 Dim lsrClm As Long Dim lstRow As Long' contando la última fila utilizada lstRow = Celdas (Rows.Count, 1) .End (xlUp) .Row Dim uniques As Range Dim clm As String, clmNo As Long On Error GoTo handler clm = Application.InputBox ("Desde qué columna desea crear archivos" & vbCrLf & "Eg A, B, C, AB, ZA, etc. ") clmNo = Range (clm &" 1 "). Column Set uniques = Range (clm &" 2: "& clm & lstRow) 'Llamar a Eliminar duplicados para obtener un conjunto de nombres únicos uniques = RemoveDuplicates (uniques) Llame a CreateSheets (uniques, clmNo) con la aplicación .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic End With Sheet1.Active MsgBox "¡Bien hecho!" Salir del controlador Data.ShowAllData: con la aplicación .ScreenUpdating = True .DisplayAlerts = True .AlertBeforeOverwriting = True .Calculation = xlCalculationAutomatic End With End Sub Función RemoveDuplicates (únicos como rango) como rango ThisWorkbook.Activate Sheets.Add On Error Resume Next ActiveSheet.Name = "uniques" Sheets ("uniques"). Activar en caso de error Ir a 0 uniques.Copy Cells (2, 1) .Active ActiveCell.PasteSpecial xlPasteValues Range ("A1") .Value = "únicos" Dim lstRow As Long lstRow = Celdas (Rows.Count, 1) .End (xlUp) .Row Range ("A2: A" & lstRow) .Seleccione ActiveSheet.Range (Selection.Address) .RemoveDuplicates Columns : = 1, Encabezado: = xlNo lstRow = Cells (Rows.Count, 1) .End (xlUp) .Row Set RemoveDuplicates = Range ("A2: A" & lstRow) End Function Sub CreateSheets (únicos como rango, clmNo como largo) Dim lstClm As Long Dim lstRow As Long For Cada único En exclusivos Sheet1.Activate lstRow = Cells (Rows.Count, 1) .End (xlUp) .Row lstClm = Cells (1, Columns.Count) .End (xlToLeft) .Column Dim dataSet As Range Establecer dataSet = Range (Cells (1, 1), Cells (lstRow, lstClm)) dataSet.AutoFilter field: = clmNo, Criteria1: = unique.Value lstRow = Cells (Rows.Count, 1) .End ( xlUp) .Row lstClm = Celdas (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 vas a correr SplitIntoSheets () procedimiento, 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 RemoveDuplicates (únicos como rango) como rango.
El primer procedimiento es SplitIntoSheets (). Este es el procedimiento principal. Este procedimiento establece las variables y Eliminar duplicados para obtener nombres únicos de la columna dada y luego pasa esos nombres a CreateSheets para crear hojas.
Eliminar duplicados toma un argumento que es rango que contiene nombre. Elimina duplicados de ellos y devuelve un objeto de rango que contiene nombres únicos.
Ahora CreateSheets se llama. Se necesitan dos argumentos. Primero los nombres únicos y segundo la columna no. a partir de los cuales obtendremos datos más ajustados. 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 preguntarla en la sección de comentarios a continuación.
Descargar archivo:
Divida la hoja de Excel en varios archivos según la columna usando VBA