2° PARTE DE Como ordenar datos con una macros en la cual están separados en distintos excel´s

Sr. Dante amor buenas ; 

Quisiera que me apoye con la segunda parte del proceso que seria ordenar los elemento a nivel de condiciones .

1 Respuesta

Respuesta
1

Te anexo la segunda parte para ordenar

Sub CargarDatos()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = l1.ActiveSheet
    h1.Cells.Clear
    tit = Array("LISTA DE MATERIALES / SPOOLA_PART NUMBER:", _
                "LISTA DE SOLDADURA / SPOOL A", _
                "LISTA DE CORTE / SPOOL A")
    dat = Array("ITEM", "SOL. N° ", "ITEM ")
    col = Array("A", "G", "L")
    fin = Array("E", "D", "F")
    '
    ruta = l1.Path & "\LISTAS\"
    arch = Dir(ruta & "*.xls*")
    Do While arch <> ""
        Set l2 = Workbooks.Open(ruta & arch, ReadOnly:=True)
        Set h2 = l2.Sheets(1)
        j = 1
        For n = LBound(dat) To UBound(dat)
            If h2.Range("A1") = dat(n) Then
                For i = 1 To h2.Range("A" & Rows.Count).End(xlUp).Row
                    If h2.Cells(i, "A") = dat(n) Then
                        j = j + 1
                        h1.Cells(j, col(n)) = tit(n)
                        j = j + 1
                    End If
                    h2.Range(h2.Cells(i, "A"), h2.Cells(i, fin(n))).Copy h1.Cells(j, col(n))
                    j = j + 1
                Next
                Exit For
            End If
        Next
        l2.Close False
        arch = Dir()
    Loop
    Call Ordenar
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub
'
Sub Ordenar()
'Por.Dante Amor
    Set h1 = Sheets("Hoja1")
    Set h2 = Sheets("Hoja2")
    h2.Cells.Clear
    '
    col = Array("A", "G", "L")
    co2 = Array("E", "J", "Q")
    '
    ufil = 0
    For m = LBound(col) To UBound(col)
        u = h1.Range(col(m) & Rows.Count).End(xlUp).Row
        If u > ufil Then ufil = u: ucol = col(m)
    Next
    '
    wmax = 0
    Do While True
        If h1.Cells(ufil, ucol) = "" Then Exit Do
        For m = LBound(col) To UBound(col)
            u = h2.Range(col(m) & Rows.Count).End(xlUp).Row + 2
            If u > wmax Then wmax = u
        Next
        '
        For n = LBound(col) To UBound(col)
            For i = 1 To h1.Range(col(n) & Rows.Count).End(xlUp).Row
                If Left(h1.Cells(i, col(n)), 8) = "LISTA DE" Then
                    h1.Range(h1.Cells(i, col(n)), h1.Cells(i, co2(n))).Select
                    h1.Range(Selection, Selection.End(xlDown)).Select
                    Selection.Copy h2.Cells(wmax, col(n))
                    Selection.Clear
                    Exit For
                End If
            Next
        Next
    Loop
    h2.Cells.Copy h1.[A1]
End Sub

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas