Error al ejecutar Macro 2 veces

Cuando ejecuto esta macro 2 veces sin cerrar el libro así sea que lo guarde antes de ejecutarlo en la segunda vez se me bloquea excel.

Sub Generacion_Plano()
'
' Macro1 Macro
'
'Con esta macro es para generar el archivo plano
'
ActiveWorkbook.Save
Range("tabla1").Copy
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "Plano"
Range("a2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Rows("1:1").Select
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Cells.Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Selection.Font.Bold = True
Selection.Font.Bold = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C2").Select
Application.CutCopyMode = False
Range("A1").Select
ActiveCell.FormulaR1C1 = "S"
Range("B1").Select
ActiveCell.FormulaR1C1 = "821505000"
Range("C1").Select
ActiveCell.FormulaR1C1 = "1" & "0" & Format(Date, "mm") - 3 & "0" & Format(Date, "mm") - 1
ActiveCell.FormulaR1C1 = "11012"
Range("D1").Select
ActiveCell.FormulaR1C1 = Format(Date, "yyyy")
Range("E1").Select
ActiveCell.FormulaR1C1 = "CGN2005_001_SALDOS_Y_MOVIMIENTOS"
Range("A1").Select
ActiveWindow.SmallScroll Down:=-3
Range("C1").Select
ActiveCell.FormulaR1C1 = "1" & "0" & Format(Date, "mm") - 3 & "0" & Format(Date, "mm") - 1
Range("A2").Select
ActiveCell.FormulaR1C1 = "=+IF(RC[1]<>0,""D"","""")"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A271"), Type:=xlFillDefault
Range("A2:A271").Select
Range("C258").Select
Sheets("Plano").Select
Sheets("Plano").Move
Cells.Select
Selection.NumberFormat = "@"
ActiveWorkbook.SaveAs Filename:="D:\cbedoya\Desktop\F1-IUPB-" & "0" & Format(Date, "mm") - 1 & Format(Date, "yy") & "-Plano.txt", _
FileFormat:=xlText, CreateBackup:=False
Application.DisplayAlerts = False
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub

1 respuesta

Respuesta
1

H o  l a:

Le agregué esta línea:

Application.ScreenUpdating = False

Sub Generacion_Plano()
'
' Macro1 Macro
'
'Con esta macro es para generar el archivo plano
'
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    ActiveWorkbook.Save
    Range("tabla1").Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "Plano"
    Range("a2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Rows("1:1").Select
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Columns("C:C").Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
    Selection.Font.Bold = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C2").Select
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "S"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "821505000"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "1" & "0" & Format(Date, "mm") - 3 & "0" & Format(Date, "mm") - 1
    ActiveCell.FormulaR1C1 = "11012"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = Format(Date, "yyyy")
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "CGN2005_001_SALDOS_Y_MOVIMIENTOS"
    Range("A1").Select
    ActiveWindow.SmallScroll Down:=-3
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "1" & "0" & Format(Date, "mm") - 3 & "0" & Format(Date, "mm") - 1
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=+IF(RC[1]<>0,""D"","""")"
    Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:A271"), Type:=xlFillDefault
    Range("A2:A271").Select
    Range("C258").Select
    Sheets("Plano").Select
    Sheets("Plano").Move
    Cells.Select
    Selection.NumberFormat = "@"
    ruta = "D:\cbedoya\Desktop\"
    'ruta = "C:\trabajo\"
    ActiveWorkbook.SaveAs Filename:=ruta & "F1-IUPB-" & "0" & Format(Date, "mm") - 1 & Format(Date, "yy") & "-Plano.txt", _
        FileFormat:=xlText, CreateBackup:=False
    ActiveWorkbook.Close
    '
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub

Prueba y me comentas.


':)
S a l u d o s . D a n t e A m o r
':) Si es lo que necesitas. Recuerda valorar la respuesta. G r a c i a s.

HoLa:

Ya intente con el arreglo que le hiciste y sigue pasando lo mismo. La primera vez no hay alguno...pero cuando lo vuelvo a ejecutar porque hice una modificación en el contenido de la hoja de calculo...aparece el mensaje "Excel dejo de Funcionar" y se cierra.

Mil Gracias

Si quieres, envíame tu archivo para revisarlo.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “krlosbedoya” y el título de esta pregunta.

Listo!!!!! Dante Amor.

Ya te envié el archivo.

Mil Gracias.

Hola Dante,

ya la revise y la ejecute y aún se sigue bloqueando....hice lo que me dijiste con F8 y en la parte en que se bloquea es a lo último, cuando va a volver a guardar nuevamente.

 ActiveWorkbook.SaveAs Filename:=ruta & "F1-IUPB-" & "0" & Format(Date, "mm") - 1 & Format(Date, "yy") & "-Plano.txt", _

        FileFormat:=xlText, CreateBackup:=False

Probaste con lo nuevo que puse, por el código que pusiste, veo que no has probado con los cambios que le hice a la macro, revisa el último archivo que te envié y prueba nuevamente.

    n = ""
    Do While True
        arch = "F1-IUPB-" & "0" & Format(Date, "mm") - 1 & Format(Date, "yy") & "-Plano" & n & ".txt"
        If Dir(ruta & arch) <> "" Then
            n = Val(n) + 1
            'Kill ruta & "F1-IUPB-" & "0" & Format(Date, "mm") - 1 & Format(Date, "yy") & "-Plano.txt"
        Else
            Exit Do
        End If
    Loop
    '
    ActiveWorkbook.SaveAs Filename:=ruta & arch, FileFormat:=xlText, CreateBackup:=False

Hola Dante Amor, 

Pues déjame decirte que ya no se bloquea y los otros archivos que genere los borro manualmente.....millones de Gracias.

Al final de mi respuesta hay 2 botones para valorar la respuesta: "Votar" y "Excelente". No olvides valorar la respuesta.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas