I have a simple code to copy and paste all the content from 1 sheet in another sheet and most of the time after the code finish to run the excel file closes and open again (but with no information).
The code is been called from a CommandButton1 inside a userform. I am put the code in the user form due to I am using a listbox to select the correct sheet to copy the information.
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False: Application.EnableEvents = False 'For less lag
Application.Calculation = xlCalculationManual
Dim sheet_name As String
Dim oShape As Shape
Alert.Rows("15:" & Rows.count).ClearContents
Alert.Activate
For Each oShape In ActiveSheet.Shapes
If Not Application.Intersect(oShape.TopLeftCell, ActiveSheet.Rows("15:" & Rows.count)) Is Nothing Then
oShape.Delete
End If
Next
Dim i As Integer, sht As String
For i = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(i) = True Then
sht = ListBox1.List(i)
End If
Next i
Sheets(sht).Activate
Application.EnableEvents = False
ActiveSheet.Range("A15:L345").Copy Alert.Range("A15")
Alert.Range("C1:C2").Value = ActiveSheet.Range("C1:C2").Value
Alert.Range("H2:L3").Value = ActiveSheet.Range("H2:L3").Value
Alert.Range("H5:L10").Value = ActiveSheet.Range("H5:L10").Value
Alert.Range("B34") = ActiveSheet.Name
ActiveSheet.Delete
Call rename
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True: Application.EnableEvents = True
End Sub
The rename sub is a simple code as well.
Sub rename()
Dim ws As Worksheet
Application.ScreenUpdating = False: Application.DisplayAlerts = False: Application.AskToUpdateLinks = False: Application.EnableEvents = False 'For less lag
Alert.Activate
Alert.Name = Alert.Range("B34")
Alert.Range("B34") = ""
Range("L2:L3").Select
Range("L5:L10").Select
With Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Alert.Range("A1").Activate
Application.ScreenUpdating = True: Application.DisplayAlerts = True: Application.AskToUpdateLinks = True: Application.EnableEvents = True
End Sub
How can I prevent it to crash?