Seleccionar datos y separarlos por hojas en otro libro

En una hoja original tengo mas de 10000 referencias (colunma C) en las que los primeros 4 digitos corresponden al proveedor y cada referencia tiene su cantidad correspondiente en la columna D. Necesito una macro que separe los datos de acuerdo a los proveedores y los copie en un libro nuevo, cada proveedor en una hoja diferente con sus respectivas cantidades.

Hoja original:

1005A0695 67

2095D0063 95

1087C8975 45

9845V6285 85

1005H6972 35

9845J3584 15

1087Y6384 98

2095P3074 10

Despues de correr la macro deben quedar asi

Hoja1:

1005A0695 67

1005H6972 35

Hoja2:

1087C8975 45

1087Y6384 98

Hoja3:

2095D0063 95

2095P3074 10

Hoja4:

9845V6285 85

9845J3584 15

Y asi sucesivamente hasta que no hayan mas datos en la hoja original.

1

1 Respuesta

3.703.775 pts. Si me amas, siempre voy a estar en tu corazón; si me...

H o l a: La siguiente macro considera la fila 1 como encabezado, y a partir de la fila 2 empiezan tus datos. Cambia en la macro "original" por el nombre de tu hoja que contiene los datos.

Sub SepararDatos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.SheetsInNewWorkbook = 1
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("original")
    h1.Copy after:=Sheets(Sheets.Count)
    Set h2 = ActiveSheet
    uf = h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row
    uc = h2.UsedRange.Columns(h2.UsedRange.Columns.Count).Column
    '
    With h2.Sort
        .SortFields.Clear
        .SortFields.Add Key:=h2.Range("C2:C" & uf), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange h2.Range(h2.Cells(1, 1), h2.Cells(uf, uc))
        .Header = xlYes: .MatchCase = False: .Orientation = xlTopToBottom
        .SortMethod = xlPinYin: .Apply
    End With
    '
    Set l2 = Workbooks.Add
    Set h3 = l2.Sheets(1)
    ant = Left(h2.Cells(2, "C"), 4)
    j = 2
    For i = 2 To h2.Range("C" & Rows.Count).End(xlUp).Row
        If ant <> Left(h2.Cells(i, "C"), 4) Then
            Set h3 = l2.Sheets.Add(after:=l2.Sheets(l2.Sheets.Count))
            j = 2
        End If
        H2. Rows(i). Copy: h3. Rows(j).PasteSpecial xlPasteValuesAndNumberFormats
        ant = Left(h2.Cells(i, "C"), 4)
        j = j + 1
    Next
    '
    ruta = l1.Path & "\"
    arch = "nuevo libro.xlsx"
    l2.SaveAs Filename:=ruta & arch, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    '
    h2.Delete
    Application.ScreenUpdating = True
    MsgBox "Libro nuevo generado"
End Sub

Al final la macro te genera un nuevo libro y lo guarda con el nombre de "nuevo libro.xlsx"


'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Dante sos un CRACK! funciono perfectamente como necesito solo una pregunta, donde puedo cambiar las columnas que me copia, es decir me copia TODAS y quisiera poder elegir que junto con la columna C se copie solo la D o la F. se puede?

Mil Gracias Dante, Excelente

Hola DANTE, por alguna razon probe el codigo el viernes y funciono perfecto, pero ahora cuando lo corro me da "error 9 en tiempo de ejecucion, subindice fuera de intervalo" y cuando le doy a DEPURAR se coloca en amarillo                 -Set h1 = l1.Sheets("original")-

ya comprobe que la hoja se llama exactamente original, no he cambiado nada desde el viernes y no se por que el error, alguna pista?

gracias por tu invaluable ayuda

El error es porque no existe una hoja llamada "original", revisa que no existan espacios en blanco antes o después en el nombre de tu hoja.

Con gusto realizo la copia de las columnas que necesites. Valora esta respuesta y crea una nueva, en el desarrollo de la pregunta escribe: "para Dante Amor"

El error que estaba pasando es que el codigo funciona perfecto cuando se corre dentro del libro que tiene la hoja "original". Pero yo lo guarde en mi libro de macros personal y desde alli da error aunque este abierta la hoja "original".

Muchas gracias Dante, claro que valorare tu raspuesta.

La macro está diseñada para ejecutarse en el libro que contiene la hoja "original", tienes que cambiar la lógica para establecer la variable l1 si vas a ejecutar la macro desde otro libro.

    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("original")

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas