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 49 50 51 52 53 54 55 56 57 58 59 60
| Sub BlackMountain()
Dim i As Integer
Dim k As Integer
i = 3
k = 3
code = Empty
Action = Empty
Do Until Cells(i, 1).Value = Empty
If Cells(i, 3) = "" Then
i = i + 1
Else:
'*********************************************************************
'Cells(i, 2).Activate
' While ActiveCell.Value = Empty
' ActiveCell.Offset(-1, 0).Select
' Wend
' Action = ActiveCell.Value
'remplacé par
Action = Cells(Rows.Count, 2).End(xlUp).Value
'*********************************************************************
'************************************************************************
If Action >= 2016 Then
'ActiveCell.Offset(0, -1).Select
'While ActiveCell.Value = Empty
' ActiveCell.Offset(-1, 0).Select
'Wend
' Code = ActiveCell.Value
'remplacer par
col = ActiveCell.Offset(0, -1).Column
code = Cells(Rows.Count, col).End(xlUp).Value
' ou bien encore puisque l'on select plus
code = Cells(Rows.Count, 2).End(xlUp).offset(0,-1).Value
'**************************************************************************
'************************************************************
' Worksheets("feuille_cible").Activate
'Cells(k, 1).Value = code
'Cells(k, 2).Value = Action
'remplacer par
With Sheets("feuille_cible")
.Cells(k, 1).Value = code
.Cells(k, 2).Value = Action
End With
'***************************************************************
Worksheets("feuille_source").Activate
code = Empty
Action = Empty
k = k + 1
i = i + 1
LgnFinCode = Empty
Else: i = i + 1
End If
End If
Loop
End Sub |
Partager