Dividir datos de una hoja Excel en grupos
"para dante amor"
Hola,
Quiero dividir cada cliente en un archivo Excel diferente.
Este es el encabezado que quiero que se repita:
El nombre del fichero quiero que coja el de la Columna A. A ser posible, me gustaría que se crearan los ficheros nuevos con el mismo tamaño de celda que estos.
De la fila 1 a la 4 hay alguna celda combinada, no se si habrá algún inconveniente.
Te anexo la macro con las características que necesitas
Sub Separar_Datos()
'Por Dante Amor
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.StatusBar = False
Set l1 = ThisWorkbook
Set h1 = Sheets("Hoja1") 'hoja con datos
Set h2 = Sheets("temp") 'hoja temporal
col = "A" 'columna clave
ucol = "K" 'ultima columna de datos
n = Columns(col).Column
h2.Cells.Clear
If h1.AutoFilterMode Then h1.AutoFilterMode = False
'
u1 = h1.Range(col & Rows.Count).End(xlUp).Row
h1.Range(col & 5 & ":" & col & u1).Copy h2.[A1]
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
h2.Range("A1:A" & u2).RemoveDuplicates Columns:=1, Header:=xlYes
'
ruta = l1.Path & "\"
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To u2
Application.StatusBar = "Generando archivo " & i - 1 & " de " & u2 - 1
clave = h2.Cells(i, "A")
If h1.AutoFilterMode Then h1.AutoFilterMode = False
h1.Copy
Set l2 = ActiveWorkbook
Set h21 = l2.Sheets(1)
h21.Cells.ClearContents
'
u1 = h1.Range(col & Rows.Count).End(xlUp).Row
h1.Range("A5:" & ucol & u1).AutoFilter Field:=n, Criteria1:=clave
u1 = h1.Range(col & Rows.Count).End(xlUp).Row
h1.Range("A1:" & ucol & u1).Copy h21.[A1]
l2.SaveAs ruta & clave, FileFormat:=xlOpenXMLWorkbook
l2.Close
Next
If h1.AutoFilterMode Then h1.AutoFilterMode = False
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Archivos creados"
End Sub.
.
Ahora si, muchas gracias.
La macro es perfecta pero seria los mas, si se pudiera dejar de copiar el formato a partir de la ultima fila con texto.
Ejemplo: el fichero lo tengo con bordes y los nuevos ficheros cuando se crean, aparecen los bordes en todo la columna y me gustaría que a partir de la ultima fila no copiara los bordes.
No sé si me explico.
En espera de tus comentarios.
Gracias.
Después de esta línea:
H21. Cells. ClearContents
Agrega esta línea
H21.rows("6:" & rows. Count). Clearprueba y me comentas
Hola,
me da error.
Después del punto (. ) No debe haber espacios
H21.Rows("6:" & Rows. Count). Clear
Lo que pasa es que el editor de esta página le pone un espacio después de cada punto. Elimina esos espacios y ya no tendrás problemas.
