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

Respuesta
1

1. ¿Los datos empiezan en la fila 2?

2. ¿Hay qué copiar el encabezado con cada bloque al nuevo archivo?

3. ¿Cómo se va a llamar cada nuevo libro?

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 Sub

Saludos.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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas