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