Autres Copier coller sous conditions

[delta6x]

Bonjour,

Je ne sais pas si c'est possible avec une ou plusieurs formules, sans VBA ni Query, pour (par exemple) :

- Si la cellule A13 = "X", les cellules A1 à C3 soient remplacées par les cellules k1 à M3, sinon on ne change rien

- Si la cellule B13 = "X", les cellules A1 à C3 soient remplacées par les cellules k5 à M7, sinon on ne change rien

- Si la cellule C13 = "X", les cellules A1 à C3 soient remplacées par les cellules K9 à M11, sinon on ne change rien

Merci d'avance et bon dimanche.

 

[fanch55]

Bonjour,
je suppose que les cellules A13,B13 et C13 sont des options,
c'est à dire qu'une et une seule = "X" ?

 

[delta6x]

Bonjour, Fanch55, Je comprends pas bien ce que tu veux dire. Si c'est un autre caractère comme "1" ou autres, ça me conviendrait parfaitement.

 

[sylvanu]

Bonjour Delta6x,
Deux solutions en PJ.
Feuil1 : il suffit de cliquer sur des trois cellules pour faire le transfert avec :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [A13:C13]) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        [A13:C13].ClearContents
        If Target.Address = "$A$13" Then
            [A13] = "X": [A1:C3] = [K1:M3].Value
        ElseIf Target.Address = "$B$13" Then
            [B13] = "X": [A1:C3] = [K5:M7].Value
        ElseIf Target.Address = "$C$13" Then
            [C13] = "X": [A1:C3] = [K9:M11].Value
         End If
    End If
Fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Feuil2, il faut mettre un X pour faire le transfert, mais ça me semble moins convivial car il faut effacer les autres X auparavant, avec :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [A13:C13]) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        If [A13] = "X" Then
            [A1:C3] = [K1:M3].Value
        ElseIf [B13] = "X" Then
            [A1:C3] = [K5:M7].Value
        ElseIf [C13] = "X" Then
            [A1:C3] = [K9:M11].Value
        End If
    End If
Fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[fanch55]

Bonjour, Fanch55, Je comprends pas bien ce que tu veux dire. Si c'est un autre caractère comme "1" ou autres, ça me conviendrait parfaitement.

Pour faire simple,:
Si a13 ="X", B13 et C13 doivent être vides
Si b13 ="X",A13 et C13 doivent être vides
Si c13 ="X",A13 et B13 doivent être vides

 

[delta6x]

oui, en fait , c'est un choix entre A13, B13, C13.....
Si A13 ="X", les autres "B13" "C13" sont vides

 

[Phil69970]

Bonjour à tous

@delta6x je te propose ce fichier

Merci de ton retour

@Phil69970

 

[fanch55]

Formule à saisir en A1 et à tirer vers C3 :

=SI(NB.SI($A$13:$C$13;"X")=1;CHOISIR(EQUIV("X";$A$13:$C$13;0);K1;K5;K9);"")

 

[delta6x]

Merci à Sylvanu, à Phil69970, et c'est sincère. Mais j'essaie depuis bien longtemps de finir mon fichier sans VBA, ni Power Query dans Excel. (les deux solutions que vous proposez sont pourtant au top). Fanch55 m'a donné la solution sans VBA, et je l'en remercie tout autant. Je vais essayer d'adapter sa solution à mon fichier. Bon dimanche à vous.

Bonjour Delta6x,
Deux solutions en PJ.
Feuil1 : il suffit de cliquer sur des trois cellules pour faire le transfert avec :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [A13:C13]) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        [A13:C13].ClearContents
        If Target.Address = "$A$13" Then
            [A13] = "X": [A1:C3] = [K1:M3].Value
        ElseIf Target.Address = "$B$13" Then
            [B13] = "X": [A1:C3] = [K5:M7].Value
        ElseIf Target.Address = "$C$13" Then
            [C13] = "X": [A1:C3] = [K9:M11].Value
         End If
    End If
Fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Feuil2, il faut mettre un X pour faire le transfert, mais ça me semble moins convivial car il faut effacer les autres X auparavant, avec :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [A13:C13]) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        If [A13] = "X" Then
            [A1:C3] = [K1:M3].Value
        ElseIf [B13] = "X" Then
            [A1:C3] = [K5:M7].Value
        ElseIf [C13] = "X" Then
            [A1:C3] = [K9:M11].Value
        End If
    End If
Fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Bonjour,

Bonjour Delta6x,
Deux solutions en PJ.
Feuil1 : il suffit de cliquer sur des trois cellules pour faire le transfert avec :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [A13:C13]) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        [A13:C13].ClearContents
        If Target.Address = "$A$13" Then
            [A13] = "X": [A1:C3] = [K1:M3].Value
        ElseIf Target.Address = "$B$13" Then
            [B13] = "X": [A1:C3] = [K5:M7].Value
        ElseIf Target.Address = "$C$13" Then
            [C13] = "X": [A1:C3] = [K9:M11].Value
         End If
    End If
Fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Feuil2, il faut mettre un X pour faire le transfert, mais ça me semble moins convivial car il faut effacer les autres X auparavant, avec :

Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fin: If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [A13:C13]) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        If [A13] = "X" Then
            [A1:C3] = [K1:M3].Value
        ElseIf [B13] = "X" Then
            [A1:C3] = [K5:M7].Value
        ElseIf [C13] = "X" Then
            [A1:C3] = [K9:M11].Value
        End If
    End If
Fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Bonjour, Sylvanu. J'ai dérogé à mes règles et adapté ta première solution. J'y ai mis le temps, mais y suis parvenu. C'est ma première macro. Je sais pas comment tu fais pour aller aussi vite, T'as peut-être un ordinateur dans le cerveau. En tous cas, tu dois avoir un sacré niveau. Encore merci, c'est super.

 

[sylvanu]

J'ai dérogé à mes règles

Oups! J'avais zappé "sans VBA"
Mais si je vous ai filé le virus ...

 

[delta6x]

oui, virus bien agréable et moins dangereux que le Covid . Encore merci