1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48
| Sub Penalties()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Application.DisplayStatusBar = False
lr = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
'COPY DATA
On Error Resume Next
ThisWorkbook.Sheets("Feuil1").Range("A2", Range("A" & lr)).Copy Destination:=Sheets("Penalties").Range("K")
ThisWorkbook.Sheets("Feuil1").Range("B2", Range("B" & lr)).Copy Destination:=ThisWorkbook.Sheets("Penalties").Range("B2")
ThisWorkbook.Sheets("Feuil1").Range("C2", Range("C" & lr)).Copy Destination:=ThisWorkbook.Sheets("Penalties").Range("C2")
ThisWorkbook.Sheets("Feuil1").Range("D2", Range("D" & lr)).Copy Destination:=ThisWorkbook.Sheets("Penalties").Range("D2")
ThisWorkbook.Sheets("Feuil1").Range("F2", Range("F" & lr)).Copy Destination:=ThisWorkbook.Sheets("Penalties").Range("E2")
ThisWorkbook.Sheets("Feuil1").Range("G2", Range("G" & lr)).Copy Destination:=ThisWorkbook.Sheets("Penalties").Range("F2")
lr4 = Sheets("Penalties").Range("A" & Rows.Count).End(xlUp).Row
For i = lr4 To 2 Step -1
If ThisWorkbook.Sheets("Penalties").Range("F" & i) >= ThisWorkbook.Sheets("Penalties").Range("G" & i) Then
ThisWorkbook.Sheets("Penalties").Range("F" & i).EntireRow.Delete
Else
'do nothing
End If
Next i
ThisWorkbook.Sheets("Penalties").Columns.AutoFit
MsgBox "Task Completed..."
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub |
Partager