Bonjour Delta6x,
Deux solutions en PJ.
Feuil1 : il suffit de cliquer sur des trois cellules pour faire le transfert avec :
VB:
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 :
Code:
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
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 :
VB:
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 :
Code:
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 Delta6x,
Deux solutions en PJ.
Feuil1 : il suffit de cliquer sur des trois cellules pour faire le transfert avec :
VB:
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 :
Code:
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.