0

Tengo el siguiente codigo de visual basic, lo que necesito que haga es: me divida una base de datos en varios archivos de Excel, en esta base de datos hay una columna llamada CODIGO, quiero que cada vez que la columna codigo cambie de valor se asignen el resto de filas con ese mismo codigo a un excel distinto , esto cada vez que ese codigo cambie de valor, sin importar si ese codigo ya lo vio hace 2 filas atras o mas

**Sub DividirEnVariosArchivos()
    Dim wbOriginal As Workbook
    Dim wbNuevo As Workbook
    Dim wsOriginal As Worksheet
    Dim rango As Range
    Dim filaInicial As Long
    Dim filaFinal As Long
    Dim columnaClave As Integer
    Dim valorActual As Variant
    Dim valorAnterior As Variant
    
    ' Establecer el libro y la hoja de trabajo originales
    Set wbOriginal = ThisWorkbook
    Set wsOriginal = wbOriginal.Sheets("Hoja1")
    
    ' Establecer la columna clave por su número (ejemplo: 1 para "A", 2 para "B", etc.)
    columnaClave = 5 ' Cambia esto por el número de tu columna clave
    
    ' Establecer la fila inicial
    filaInicial = 2 ' Asume que la primera fila tiene encabezados
    
    ' Establecer el valor anterior al de la primera fila de datos
    valorAnterior = wsOriginal.Cells(filaInicial, columnaClave).Value
    
    ' Recorrer las filas desde la segunda hasta la última con datos
    For filaFinal = filaInicial + 1 To wsOriginal.Cells(wsOriginal.Rows.Count, columnaClave).End(xlUp).Row
        ' Obtener el valor actual de la columna clave
        valorActual = wsOriginal.Cells(filaFinal, columnaClave).Value
        
        ' Verificar si el valor ha cambiado
        If valorActual <> valorAnterior Then
            ' Definir el rango a copiar
            Set rango = wsOriginal.Range(wsOriginal.Cells(filaInicial, 1), wsOriginal.Cells(filaFinal - 1, wsOriginal.Columns.Count))
            
            ' Crear un nuevo libro de trabajo
            Set wbNuevo = Workbooks.Add
            
            ' Pegar el rango en el nuevo libro de trabajo
            rango.Copy Destination:=wbNuevo.Sheets(1).Cells(1, 1)
            
            ' Guardar el nuevo libro de trabajo con un nombre basado en el valor anterior
            wbNuevo.SaveAs "C:\ruta\a\tu\carpeta\datos_" & valorAnterior & ".xlsx"
            
            ' Cerrar el nuevo libro de trabajo
            wbNuevo.Close SaveChanges:=False
            
            ' Actualizar la fila inicial y el valor anterior
            filaInicial = filaFinal
            valorAnterior = valorActual
        End If
    Next filaFinal
    
    ' Copiar y guardar el último conjunto de datos
    Set rango = wsOriginal.Range(wsOriginal.Cells(filaInicial, 1), wsOriginal.Cells(filaFinal, wsOriginal.Columns.Count))
    Set wbNuevo = Workbooks.Add
    rango.Copy Destination:=wbNuevo.Sheets(1).Cells(1, 1)
    wbNuevo.SaveAs "C:\Users\carlo\Desktop\resultado\datos_" & valorAnterior & ".xlsx"
    wbNuevo.Close SaveChanges:=False
End Sub**
1
  • El problema en general es que por alguna razon el codigo no esta funcionando bien, ya verifique que este siguiendo las rutas correctas, no se si alguno lo pudiera probara ver si le sirve, por lo general me manda el error 1004 Commented el 15 may. a las 23:29

1 respuesta 1

1

Creo que encontre una posible solucion para mi problema, lo que hice fue que lo vaya diviendo por codigos

Sub DividirLibroPorColumna()

' Definir la columna que contiene los valores de división
Const columnaDividir As Integer = 5 ' Cambiar por el número de columna real

' Definir la ruta de la carpeta para guardar los libros divididos
Const rutaCarpetaSalida As String = "C:\Users\carlo\Desktop\resultado" ' Cambiar la ruta según sea necesario

' Obtener la hoja de trabajo activa
Dim hojaTrabajo As Worksheet
Set hojaTrabajo = ThisWorkbook.ActiveSheet

' Obtener la última fila con datos
Dim ultimaFila As Long
ultimaFila = hojaTrabajo.Cells(Rows.Count, columnaDividir).End(xlUp).Row

' Obtener el rango de datos a procesar
Dim rangoDatos As Range
Set rangoDatos = hojaTrabajo.Range(hojaTrabajo.Cells(1, columnaDividir), hojaTrabajo.Cells(ultimaFila, columnaDividir))

' Crear un diccionario para almacenar los datos agrupados
Dim diccionarioDatos As Object
Set diccionarioDatos = CreateObject("Scripting.Dictionary")

' Agrupar las filas por el valor de la columna especificada
Dim valorColumna As Variant
Dim rangoFilaActual As Range
For Each rangoFilaActual In rangoDatos
    valorColumna = rangoFilaActual.Value
    If Not diccionarioDatos.Exists(valorColumna) Then
        ' Crear una nueva entrada en el diccionario para el valor actual
        Set diccionarioDatos(valorColumna) = rangoFilaActual.EntireRow ' Almacenar toda la fila
    Else
        ' Agregar la fila actual al rango existente
        Set diccionarioDatos(valorColumna) = Union(diccionarioDatos(valorColumna), rangoFilaActual.EntireRow)
    End If
Next rangoFilaActual

' Procesar cada grupo de filas en el diccionario
Dim codigoGrupo As Variant
Dim rangoGrupoActual As Range
For Each codigoGrupo In diccionarioDatos.Keys
    Set rangoGrupoActual = diccionarioDatos(codigoGrupo)

    ' Crear un nuevo libro de Excel
    Dim libroNuevo As Workbook
    Set libroNuevo = Workbooks.Add

    ' Copiar el rango de filas al nuevo libro
    rangoGrupoActual.Copy Destination:=libroNuevo.Sheets(1).Range("A1")

    ' Guardar el libro nuevo con un nombre personalizado
    Dim nombreLibro As String
    nombreLibro = CStr(codigoGrupo) & ".xlsx" ' Convertir a String
    libroNuevo.SaveAs rutaCarpetaSalida & nombreLibro

    ' Cerrar el libro nuevo
    libroNuevo.Close SaveChanges:=False

Next codigoGrupo

' Mensaje de confirmación
MsgBox "Los libros se han dividido exitosamente."

End Sub

Tu Respuesta

By clicking “Publica tu respuesta”, you agree to our terms of service and acknowledge you have read our privacy policy.

¿No es la respuesta que buscas? Examina otras preguntas con la etiqueta o formula tu propia pregunta.