Macro excel para separar listado conforme a los clientes
Sepapar listado segun el clientes
LISTADO DE CARGA ES ASÍEn el listado de carga los clientes están en la columna C donde dice LineIDEs el mismo proceso separa la información por clientes crear libros nuevos para cada cliebre con el nombre LOAD TALLY SHEET + (nombre de del cliente ) y se guarde en el escritorio.
1 respuesta
Te anexo la macro
Sub Descargar()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = ActiveSheet
Set h2 = Sheets.Add
ruta = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
'
u = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("C:C").Copy h2.[A1]
h2.Range("C:C").RemoveDuplicates Columns:=1, Header:=xlYes
h2.Range("A1").Copy h2.Range("B1")
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
h2.[B2] = h2.Cells(i, "A")
Set l2 = Workbooks.Add
Set h3 = l2.ActiveSheet
h1.Range("A1:T" & u).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=h2.Range("B1:B2"), CopyToRange:=h3.Range("A1"), Unique:=False
l2.SaveAs ruta & "LOAD TALLY SHEET " & h2.Cells(i, "A")
l2.Close
Next
h2.Delete
MsgBox "Descarga de clientes terminada", vbInformation
End SubSaludos.Dante Amor
No olvides valorar la respuesta.
esta macro no funciona me creo aproximadamente 480 libros nuevos y los vuelve a borrar. pareciera que hace 1 libro por cada fila que contiene datos. y antes de finalizar el trabajo aparece un error que marca el num 400.
la primera macro fucniona a la perfeccion y en 10 segundos esta hecho el trabajo.
de atemano gracias por tu ayuda y tu tiempo.
Esta macro funciona si el cliente está en la columna C, tal vez la estás ejecutando con otro archivo.
Envíame tu archivo con la macro para revisarlo.
Saludos. Dante Amor
Te anexo la macro con la actualización
Sub Descargar()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set l1 = ThisWorkbook
Set h1 = ActiveSheet
Set h2 = Sheets.Add
ruta = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\"
'
u = h1.Range("A" & Rows.Count).End(xlUp).Row
h1.Range("C:C").Copy h2.[A1]
h2.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
h2.Range("A1").Copy h2.Range("B1")
For i = 2 To h2.Range("A" & Rows.Count).End(xlUp).Row
h2.[B2] = h2.Cells(i, "A")
Set l2 = Workbooks.Add
Set h3 = l2.ActiveSheet
h1.Range("A1:T" & u).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=h2.Range("B1:B2"), CopyToRange:=h3.Range("A1"), Unique:=False
l2.SaveAs ruta & "LOAD TALLY SHEET " & h2.Cells(i, "A")
l2.Close
Next
h2.Delete
MsgBox "Descarga de clientes terminada", vbInformation
End Sub
Hola amigos sobre este tema como puedo hacer esto mismo pero que al momento de copiar los archivos tengo celdas que están formuladas y al momento de separar las hojas me quita las fórmulas quiero que queden igual con su fórmulas. - Cesar Hidalgo
Disculpen igual en ves de dejarlos en escritorio poder seleccionar una carpeta - Cesar Hidalgo