Copier coller certaines cellules sur autre feuille

Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select
Selection.Copy Feuil2.Range("A65536").End(xlUp)(2)

Union(Cells(L, 1), Cells(L, 3), Cells(L, 16), Cells(L, 17), Cells(L, 20), Cells(L, 21)).Copy _
    Feuil2.Range("A65536").End(xlUp)(2)

'Appel du programme avec passage des paramètres
'Feuille destination, nom de la feuille origine,Ligne active, couleur, adresse de la cellule active dans la feuille initiale
Sub CopierPromesses()
Call Copiedonnees("PROMESSES", ActiveSheet.Name, ActiveCell.Row, 22, ActiveCell.Address)
End Sub
Sub CopierRCI()
Call Copiedonnees("RCI", ActiveSheet.Name, ActiveCell.Row, 22, ActiveCell.Address)
End Sub


Private Sub Copiedonnees(Nomfeuille1 As String, Nomfeuille2 As String, L As Long, couleur As Byte, adresse As String)
Dim Prop1 As DocumentProperty
Dim lig2 As Long
Dim iRet As Integer
Dim strPrompt As String
Dim strTitle As String

With Sheets(Nomfeuille1) 
lig2 = .Range("A" & .Rows.Count).End(xlUp).Row + 1 ' ligne pour mettre la copie
For Each Prop1 In ActiveWorkbook.CustomDocumentProperties ' pour chaque valeur ajouté dans les propriétés du classeur actif

    If InStr(1, UCase(Prop1.Name), "COLONNE") > 0 Then ' si dans le nom de la propriété on trouve le mot colonne alors 
        If Trim(Prop1.Value) <> "" Then ' si on a une valeur qui n'est pas un espace 
            .Range(Prop1.Value & lig2) = Sheets(Nomfeuille2).Range(Prop1.Value & L)' on recopie, la cellule qui a pour coordonnée la ligne active et pour colonne la valeur inscrite dans la propriété, dans la feuille spécifié.
' technique pour répondre à cette phrase ; "Idéalement en fonction du titre de la colonne"
' comme il n'y avait pas de nom, j'ai choisi une autre solution 

        End If
    End If
Next Prop1

Sheets(Nomfeuille2).Range(Cells(L, 1), Cells(L, 45)).Interior.ColorIndex = couleur

Sheets(Nomfeuille2).Range(adresse).Offset(1, 0).Select

 
    ' Promt
    strPrompt = "La sélection a bien été copiée dans " & Nomfeuille1
     ' Dialog's Title
    strTitle = "Ok"
 
    'Display MessageBox
    iRet = MsgBox(strPrompt, vbQuestion, strTitle)
End With
End Sub