Solved: Program is slow

[Volvo850]

Hello there I am a beginner i VBA

I made the program below it works but is very slow.
The copy below is just a part of the program the pice below is repeated
15 times

The program selects data from excel sheets and sorts it for a printform

[VBA]Private Sub CmdBtn5_Click()
Application.ScreenUpdating = False

'vult de waardes van de twee comboboxen in printliste
Sheets("Printliste").Range("I1").Value = Cboaggtype1.Value
Sheets("Printliste").Range("J1").Value = Cbomodnr1.Value

'delete empty rows and sort on col.A duplicate and col.B duplicate
'then sum in col.C and delete lowest duplicate
Dim xrow As Integer
Dim K As Integer
Dim j As Integer
Dim A As String
Dim B As String
Dim C As Integer
Dim i As Integer

'selecteer de data in kolom B tm F (Hatt)
'Copy named range to somewhere ("A200")
Sheets("Deleliste").Range("B1:F29").Copy Range("A200")
Range("A200").Select
If Range("A201") <> "" Then
Selection.End(xlDown).Select
End If
'check 200 rows of named range and delete empty rows
For i = 400 To 200 Step -1
If Cells(i, "A") = "" Then
'Is blank
Cells(i, "A").EntireRow.Delete
End If
Next i
'check for duplicate value's col.A and B sum duplicates in col.C and delete lowest duplicate row
xrow = ActiveCell.Row
Range("A202").Select
For K = 1 To xrow
If ActiveCell.Value <> "" Then
A = ActiveCell.Value
B = ActiveCell.Offset(0, 1).Value
C = ActiveCell.Offset(0, 2).Value
For j = 1 To xrow
If ActiveCell.Offset(j, 0).Value = A Then
If ActiveCell.Offset(j, 1).Value = B Then
C = C + ActiveCell.Offset(j, 2).Value
ActiveCell.Offset(0, 2).Value = C
ActiveCell.Offset(j, 0).EntireRow.Delete
j = j - 1
End If
End If
Next j
ActiveCell.Offset(1, 0).Select
End If
Next K
'copy the selected data to the printliste
Range("A200300").Copy Sheets("Printliste").Range("A6")
Sheets("Deleliste").Select

'selecteer de data in kolom G tm K (Hatt deling)
'Copy named range to somewhere ("A200")
Sheets("Deleliste").Range("G1:K29").Copy Range("A200")
Range("A200").Select
If Range("A201") <> "" Then
Selection.End(xlDown).Select
End If
'check 200 rows of named range and delete empty rows
For i = 400 To 200 Step -1
If Cells(i, "A") = "" Then
'Is blank
Cells(i, "A").EntireRow.Delete
End If
Next i
'check for duplicate value's col.A and B sum duplicates in col.C and delete lowest duplicate row
xrow = ActiveCell.Row
Range("A202").Select
For K = 1 To xrow
If ActiveCell.Value <> "" Then
A = ActiveCell.Value
B = ActiveCell.Offset(0, 1).Value
C = ActiveCell.Offset(0, 2).Value
For j = 1 To xrow
If ActiveCell.Offset(j, 0).Value = A Then
If ActiveCell.Offset(j, 1).Value = B Then
C = C + ActiveCell.Offset(j, 2).Value
ActiveCell.Offset(0, 2).Value = C
ActiveCell.Offset(j, 0).EntireRow.Delete
j = j - 1
End If
End If
Next j
ActiveCell.Offset(1, 0).Select
End If
Next K
'copy the selected data to the printliste
Range("A200300").Copy Sheets("Printliste").Range("G6")
Sheets("Deleliste").Select[/VBA]