Si la hoja no existe crear un nueva . Como lo hago

Tengo un asiento que va desde a2 .. E2 y la macro toma el valor de C2 y copia el asiento a la hoja actual primero y despues la se que indica en C2 . Hasta ahi todo bien, pero si la hoja no esta o escribi mal el nombre da error . Que quisiera, que si la hoja no esta pregunte via msgbox si le doy de alta o no . Si pulso no, salir de la macro y si pulso si, hacer una hoja nueva con el nombre de C2 y copiar el rango a1.. E2 y si se puede darle ese formato de ancho de columnas mejor. Aqui el codigo que tengo :

Sub Macro1()

' Macro1 Macro

' Acceso directo: Ctrl+Mayús+F
'Range("A2:e2").Select
Range("A2:e2").Copy

ActiveSheet.Range("A5").End(xlDown).Offset(1, 0).Select
ActiveCell.PasteSpecial xlValues

Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireRow.Insert

Range("A2:e2").Select
Range("A2:e2").Copy

Application.Goto Sheets(Sheets("LIBRO DIARIO").[C2].Text).[C2]

Range("A2").Select

ActiveSheet.Range("A2").End(xlDown).Offset(1, 0).Select
ActiveCell.PasteSpecial xlValues

Application.CutCopyMode = False
ActiveCell.Offset(1, 0).Select
ActiveCell.EntireRow.Insert

Sheets("libro diario").Select

Range("A2").Select
Range("A2:e2").ClearContents

End Sub

2 Respuestas

Respuesta
1

Estos ejemplo

http://www.programarexcel.com/2015/11/como-insertar-y-borrar-hojas-en-excel.html?m=1  

http://www.programarexcel.com/2015/09/como-agregar-hojas-de-excel-con-macro.html?m=1 

Respuesta
1

Te anexo la macro actualizada

Sub Macro1()
'
    ' Acceso directo: Ctrl+Mayús+F
    Range("A2:e2").Copy
    ActiveSheet.Range("A5").End(xlDown).Offset(1, 0).Select
    ActiveCell.PasteSpecial xlValues
    Application.CutCopyMode = False
    ActiveCell.Offset(1, 0).Select
    ActiveCell.EntireRow.Insert
    Range("A2:e2").Select
    Range("A2:e2").Copy
    '
    'Act.Por.Dante Amor
    hoja = Sheets("LIBRO DIARIO").[C2].Value
    existe = False
    For Each h In Sheets
        If LCase(h.Name) = LCase(hoja) Then
            existe = True
            Exit For
        End If
    Next
    If existe = False Then
        res = MsgBox("No existe la hoja : " & hoja & vbCr & _
                     " Quieres darla de alta", vbQuestion + vbYesNo, "ALTA HOJA")
        If res = vbNo Then Exit Sub
        '
        Sheets.Add
        ActiveSheet.Name = hoja
        Range("A2").Select
    Else
        Application.Goto Sheets(Sheets("LIBRO DIARIO").[C2].Text).[C2]
        Range("A2").Select
        On Error Resume Next
        ActiveSheet.Range("A2").End(xlDown).Offset(1, 0).Select
        werr = Err.Number
        If werr <> 0 Then
            ActiveSheet.Range("A2").Offset(1, 0).Select
        End If
    End If
    '
    ActiveCell.PasteSpecial xlValues
    ActiveCell.PasteSpecial Paste:=xlPasteColumnWidths
    Application.CutCopyMode = False
    ActiveCell.Offset(1, 0).Select
    ActiveCell.EntireRow.Insert
    '
    Sheets("libro diario").Select
    Range("A2").Select
    Range("A2:E2").ClearContents
End Sub
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Hola Dante , te felicito por tus conocimientos y te agradezco el codigo , esta imponente!!! pero tendria que hacerle una correcion , la culpa fue mia que no me explique bien .Seria que si va a crear una hoja nueva  duplique una hoja que se llama formato , le ponga el nombre de C2 y despues si haga lo mismo de copiar a2..e2 e insertar fila .

Te agradezco pila 

No sé cómo tienes los datos en la hoja "libro diario" ni como los tienes en la hoja "formato", solamente estoy suponiendo. Prueba con la siguiente macro

Sub Macro1()
'
    ' Acceso directo: Ctrl+Mayús+F
    Range("A2:e2").Copy
    ActiveSheet.Range("A5").End(xlDown).Offset(1, 0).Select
    ActiveCell.PasteSpecial xlValues
    Application.CutCopyMode = False
    ActiveCell.Offset(1, 0).Select
    ActiveCell.EntireRow.Insert
    Range("A2:e2").Select
    Range("A2:e2").Copy
    '
    'Act.Por.Dante Amor
    Set h1 = Sheets("LIBRO DIARIO")
    hoja = Sheets("LIBRO DIARIO").[C2].Value
    existe = False
    For Each h In Sheets
        If LCase(h.Name) = LCase(hoja) Then
            existe = True
            Exit For
        End If
    Next
    If existe = False Then
        res = MsgBox("No existe la hoja : " & hoja & vbCr & _
                     " Quieres darla de alta", vbQuestion + vbYesNo, "ALTA HOJA")
        If res = vbNo Then Exit Sub
        '
        'Sheets.Add
        Sheets("formato").Copy after:=Sheets(Sheets.Count)
        ActiveSheet.Name = hoja
        'Range("A2").Select
    End If
    'Else
    Application.Goto Sheets(Sheets("LIBRO DIARIO").[C2].Text).[C2]
    Range("A2").Select
    On Error Resume Next
    ActiveSheet.Range("A2").End(xlDown).Offset(1, 0).Select
    werr = Err.Number
    If werr <> 0 Then
        ActiveSheet.Range("A2").Offset(1, 0).Select
    End If
    'End If
    '
    h1.Range("A2:E2").Copy
    ActiveCell.PasteSpecial xlValues
    ActiveCell.PasteSpecial Paste:=xlPasteColumnWidths
    Application.CutCopyMode = False
    ActiveCell.Offset(1, 0).Select
    ActiveCell.EntireRow.Insert
    '
    Sheets("libro diario").Select
    Range("A2").Select
    Range("A2:E2").ClearContents
End Sub

sal u dos

¡Gracias! Dante . La hoja quedo muy bien, funciona todo perfecto, solo queda un error que no le veo solución, te explico . donde traspaso el asiento inserto una fila que queda en blanco para el próximo asiento y cuando aplico un filtro sale todo más la fila en blanco por lo tanto si doy alta a un asiento con algún filtro en la hoja el próximo asiento entra abajo de ese filtro cosa que al sacar o hacer otro filtro ahí aparece el asiento en cualquier parte de la hoja .

Pero bien esto se soluciona no aplicando filtros cuando se ingresan asientos .

Bueno muchas muchas gracias

Con gusto te ayudo con lo del filtro, pero tendría que ver cómo tienes los datos y rehacer la macro.

Crea una nueva pregunta. sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas