Copie

L'objectif est de copier des cellules en fonction de la valeur d'autres cellules.

1 2 a
2 5 b
3 4 c
4 1 d
5 3 e
On veut obtenir ceci :
1 d 2 a
2 a 5 b
3 e 4 c
4 d 1 d
5 b 3 e

Macro :

Sub Copie()
    Dim DerniereLigne
    Dim CelluleA As Range
    Dim CelluleB As Range
    Const ColonneARemplir = 13 'Colonne M
    Const ColonneACopier = 18  'Colonne R
    Dim LigneActive
    LigneActive = 2
    DerniereLigne = DetermineDerniereLigne(2)
    For Each CelluleA In ActiveSheet.Range(Cells(2, 2), Cells(DerniereLigne, 2))
        For Each CelluleB In ActiveSheet.Range(Cells(2, ColonneACopier), Cells(DerniereLigne, ColonneACopier))
            If CelluleA = CelluleB Then
                Cells(LigneActive, ColonneARemplir).Select
                Selection.Value = CelluleB.Offset(0, 1).Value
                Selection.Offset(0, 1).Value = CelluleB.Offset(0, 2).Value
                LigneActive = LigneActive + 1
                Exit For
            End If
        Next
    Next
End Sub

Function DetermineDerniereLigne(Colonne As Integer)
    Dim ligneFin
    ligneFin = 1
    Do While Not IsEmpty(ActiveSheet.Cells(ligneFin, Colonne))
        ligneFin = ligneFin + 1
    Loop
    DetermineDerniereLigne = ligneFin
End Function

Remarques

Exit For permet de sortir de la boucle en cours.