Quisiera modificar una macro de Dante Amor, para mantener el ancho de columnas en las hojas nuevas.

Según la siguiente macro.

¿Es posible que las hojas nuevas que se van generando, mantengan el ancho de columnas y alto de filas de la primera hoja?

También que lo pegado en las hojas nuevas se establezca como área de impresión.

Sub CrearyCopiar()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("PROPUESTA")
    For i = 7 To h1.Range("B" & Rows.Count).End(xlUp).Row
        If h1.Cells(i, "B") <> "" Then
            existe = False
            For Each h2 In Sheets
                If h2.Name = h1.Cells(i, "B") Then
                    existe = True
                    Exit For 

               End If
            Next
            If existe Then
                u = h2.Range("B" & Rows.Count).End(xlUp).Row + 1
                h1.Rows(i).Copy h2.Rows(u)
            Else
                Set h3 = Sheets.Add(after:=Sheets(Sheets.Count))
                hoja = h1.Cells(i, "B")
                h3.Name = h1.Cells(i, "B")
                h1.Rows(1 & ":" & 6).Copy h3.Range("A1")
                h1.Rows(i).Copy h3.Rows(7)
            End If
        End If
    Next
End Sub

1 respuesta

Respuesta
2

Te anexo la macro con la actualización:

Sub CrearyCopiar()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set h1 = Sheets("PROPUESTA")
    For i = 7 To h1.Range("B" & Rows.Count).End(xlUp).Row
        If h1.Cells(i, "B") <> "" Then
            existe = False
            For Each h2 In Sheets
                If h2.Name = h1.Cells(i, "B") Then
                    existe = True
                    Exit For
               End If
            Next
            If existe Then
                u = h2.Range("B" & Rows.Count).End(xlUp).Row + 1
                h1.Rows(i).Copy h2.Rows(u)
            Else
                h1.Copy after:=Sheets(Sheets.Count)
                Set h3 = ActiveSheet
                h3.Cells.Clear
                h3.Name = h1.Cells(i, "B")
                h1.Rows(1 & ":" & 6).Copy h3.Range("A1")
                h1.Rows(i).Copy h3.Rows(7)
            End If
        End If
    Next
End Sub

No olvides valorar la respuesta.

¡Gracias! 

Sencillamente, perfecto.

Muy amable.

Hola.

Me sale un error cuando ejecuto la macro dos veces seguidas.

Si ejecuto la macro y después tengo que modificar la hoja "PROPUESTA", al volver a ejecutar la macro, salen errores.

Se me ocurre, que al principio de la macro, elimine todas las hojas excepto "PROPUESTA" Y "datos", y después continue con tu macro.

O quizás tengas una propuesta mejor.

¿Me puedes ayudar por favor?.

Gracias y un saludo,

Ya la ejecuté más de 2 veces seguidas y no me envía ningún error.

¿Puedes decirme qué error te envía y cuando le pones depurar cuál línea del código se pone en amarillo?

También revisa los nombres de las hojas que no tenga caracteres especiales como "% / \, esos caracteres no son aceptados en los nombres de las hojas, o bien, el largo del nombre excede los 30 caracteres

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas