Can you make this Code smaller, and minimize the time of execution?

[Just Fateh]

hello, can you help me with that code,
i'm new with excel (you can say that, i don't know a thing about it),
i just create this code by: copy and past from here and there,, without knowing excatly what it does mean..
but, he is work perfectly.
now i have a small problem, the code is taking too long to execute??
( i have now 8000 row in my worksheet).
when i delete all the database he works perfectly.

this is the code:

Private Sub CopieButton_Click()
Application.ScreenUpdating = False
Sheets("VENTES").Select


'Copy first data from Userform to first row of the worksheets
Dim irow As Long
Dim ws As Worksheet
Set ws = Worksheets("VENTES")


'find first row in database
irow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row


With ws
.Range("A" & irow) = Me.NumeroBonBox.Value
.Range("B" & irow) = Me.OpérationBox.Value
.Range("C" & irow) = Me.DateBox.Value
.Range("D" & irow) = Me.ClientBox.Value
.Range("E" & irow) = Me.Produit01.Value
.Range("I" & irow) = Me.TextBox1.Value
.Range("G" & irow) = Me.PU01.Value
.Range("H" & irow) = Me.Qté01.Value
.Range("F" & irow) = Me.Total01.Value
.Range("J" & irow) = Me.PrixG01.Value
.Range("K" & irow) = Me.TTC.Value
.Range("L" & irow) = Me.MontantRécu.Value
.Range("O" & irow) = Me.PlatsRestant.Value
.Range("N" & irow) = Me.PlatsRécu.Value
.Range("M" & irow) = Me.MontantRestant.Value
.Range("P" & irow) = Me.Consine.Value
.Range("Q" & irow) = Me.Observation.Value


End With
'********************************


'Copy data from Userform to worksheets


Dim i As Integer
For i = 2 To 9


'find first row in database
irow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row


With ws
.Range("A" & irow) = Me.NumeroBonBox.Value
.Range("B" & irow) = Me.OpérationBox.Value
.Range("C" & irow) = Me.DateBox.Value
.Range("D" & irow) = Me.ClientBox.Value
.Range("E" & irow) = Controls("Produit0" & i).Value
.Range("I" & irow) = Controls("TextBox" & i).Value
.Range("G" & irow) = Controls("PU0" & i).Value
.Range("H" & irow) = Controls("Qté0" & i).Value
.Range("F" & irow) = Controls("Total0" & i).Value
.Range("J" & irow) = Controls("PrixG0" & i).Value
.Range("L" & irow) = "0"
.Range("N" & irow) = "0"
.Range("P" & irow) = "0"


End With
Next
'********************************


'Copy data from Userform to worksheets


Dim e As Integer
For e = 0 To 2
'find first row in database
irow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row


With ws
.Range("A" & irow) = Me.NumeroBonBox.Value
.Range("B" & irow) = Me.OpérationBox.Value
.Range("C" & irow) = Me.DateBox.Value
.Range("D" & irow) = Me.ClientBox.Value
.Range("E" & irow) = Controls("Produit1" & e).Value
.Range("I" & irow) = Controls("TextBox1" & e).Value
.Range("G" & irow) = Controls("PU1" & e).Value
.Range("H" & irow) = Controls("Qté1" & e).Value
.Range("F" & irow) = Controls("Total1" & e).Value
.Range("J" & irow) = Controls("PrixG1" & e).Value
.Range("L" & irow) = "0"
.Range("N" & irow) = "0"
.Range("P" & irow) = "0"


End With
Next


'********************************
'clear empty contetnts
'********************************
Dim lngLastRow As String
Dim lastRow As Long
Dim lastcolumn As Long
Dim a As Integer
Dim b As Integer
Dim c As Integer


lastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
lastcolumn = ActiveSheet.UsedRange.Column - 1 + ActiveSheet.UsedRange.Columns.Count


For a = lastRow To (lastRow - 12) Step -1
For b = lastcolumn To 1 Step -1




If Cells(a, 5).Value = "" Then
If Cells(a - 1, 5).Value = "" Then
Range(Cells(a, b), Cells(a - 1, b)).Select
Selection.ClearContents


End If
End If
Next
Next


'********************************
'Copy data from Userform to worksheets and merge cells


If Sheets("TDBP").Range("H21").Value <> 0 Then


'find first row in database
irow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row


With ws
.Range("A" & irow) = Me.NumeroBonBox.Value
.Range("B" & irow) = Me.OpérationBox.Value
.Range("C" & irow) = Me.DateBox.Value
.Range("D" & irow) = Me.ClientBox.Value
.Range("E" & irow) = Sheets("TDBP").Range("G21").Value
.Range("F" & irow) = "0"
.Range("G" & irow) = Me.Remise.Value
.Range("H" & irow) = "0"
.Range("I" & irow) = "0"
.Range("J" & irow) = Me.Remise.Value
.Range("L" & irow) = "0"
.Range("N" & irow) = "0"
.Range("P" & irow) = "0"
.Range("E" & irow) = Sheets("TDBP").Range("G21").Value
.Range("A" & irow, "Q" & irow).Select


   With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
   End With
   
End With
Else
irow = ws.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With ws
.Range("A" & irow, "Q" & irow).Select
  With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
   End With
End With
End If




End Sub

 

[jkpieterse]

As one of the first lines add

Application.ScreenUpdating = False

and perhaps

Application.Calculation = xlCalculationManual

Don't foget to turn back on:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

 

[Just Fateh]

this does not solve the problem, it's still take too long to run the code

As one of the first lines add

Application.ScreenUpdating = False

and perhaps

Application.Calculation = xlCalculationManual

Don't foget to turn back on:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

 

[jkpieterse]

Hmmm. Best to time your routine to see which part is slow. One thing I know for sure: settting borders is slow, try commenting that last bit, see if it helps.