Copiar N bloques de datos separados por una fila en blanco, todos los bloques deberán de ser pegados en un libro nuevo c/u.
Nuevamente necesitó de tú ayuda, tengo una hoja de excel con el nombre informes que puede tener "N" bloques de registros separadas por una fila en blanco los encabezados del reporte se encuentran en lad celdas "A1:F1" y los bloques de registros pueden variar ejemplo un bloque puede tener 5 registros y otro pude tener solo un registro, cada bloque debe de ser copiado en un libro nuevo indicando cuando la macro terminé de realizar su proceso debera de indicarnos con un "Msgbox".
1 respuesta
Hola Dam gracias por tu pronta respuesta.
1- Los datos comienzan en la fila 2.
2- El encabezado si debe de ser copiado en cada archivo "Nuevo".
3- Cada libro se llamará como lo indica su primer celda en este caso esa celda siempre esta en la columna "A", ejemplo: el primer bloque inicia en el rango "A2:F7" y la celda "A2" contiene este valor 1285, el nombre del archivo deberá ser 1285, el segundo bloque inicia en el rango "A9:F12" y la celda "A9" contiene este valor 1745, el nombre del archivo deberá ser 1745.
Muchas gracias por tú apoyo Dam, saludos
Te anexo la macro
Sub GuardarBloques()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
ruta = l1.Path & "\"
u = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A2").Select
ini = Selection.Row
'
Do While Selection.Row < u
Selection.End(xlDown).Select
fin = Selection.Row
'
Set l2 = Workbooks.Add
Set h2 = l2.Sheets(1)
h1.Rows(1).Copy h2.Rows(1)
h1.Range("A" & ini & ":F" & fin).Copy h2.[A2]
nom = h2.[A2]
l2.SaveAs ruta & nom & ".xlsx"
l2.Close
'
Selection.End(xlDown).Select
ini = Selection.Row
Loop
MsgBox "Terminado", vbInformation, "CREAR LIBROS"
End SubSaludos.Dante Amor. Recuerda valorar la respuesta.
Amigo Dam, la macro se saltó algunos bloques de información crees posible que te pueda enviar mi archivo de Excel?
Saludos
Revisa tus bloques, deberá existir una línea en blanco entre bloque y bloque, revisa que esa línea en la celda de la columna exista un vacío, es decir, no debe haber ni blancos.
También revisa si no tienes celdas combinadas.
Ya lo revise y cuando el primer bloque es de una línea la macro copia el primer registro del segundo bloque y guarda el archivo, posteriormente omite al segundo bloque pasando al tercer bloque de registros y guarda rl archivo, todos los registros están separados por una linea en blanco
Pero además de estar en blanco la celda de la columna A tiene que estar vacía, si la celda tiene un espacio en blanco la va a considerar como parte del rango.
Si todavía tienes problemas Envíame tu archivo con todo y macro para revisarlo.
Dime cuáles son los bloques con los que tienes problemas
Recuerda poner en el asunto del correo tu nombre de usuario.
Te cambio la macro, los archivos se guardan en c:\clientes\
Sub GuardarBloques()
'Por.Dante Amor
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'
Set l1 = ThisWorkbook
Set h1 = l1.ActiveSheet
ruta = l1.Path & "\"
u = Range("A" & Rows.Count).End(xlUp).Row + 1
ini = 2
bloque = True
'
For i = 2 To Range("A" & Rows.Count).End(xlUp).Row + 1
If Cells(i, "A") = "" Then
bloque = True
fin = i - 1
Set l2 = Workbooks.Add
Set h2 = l2.Sheets(1)
h1.Rows(1).Copy h2.Rows(1)
h1.Range("A" & ini & ":F" & fin).Copy h2.[A2]
nom = h2.[A2]
l2.SaveAs ruta & nom & ".xlsx"
l2.Close
Else
If bloque Then
ini = i
bloque = False
End If
End If
'
Next
MsgBox "Terminado", vbInformation, "CREAR LIBROS"
End Sub
