copie de cellule

[Manu62]

bonjour

j'ai 2 formules que je souhaite "copier / coller" dans une cellule.
les 2 formules sont différentes et en fonction de la cellule, soit je prend la formule 1 ou alors la 2.

je recherche via un bouton, le code qui me permet de :
si je suis en cellule a10, de me recopie la formule qui se trouve en a1
ou alors la formule qui se trouve en a2.

deux boutons form 1 et form 2 ira très bien.

merci d'avance

manu

 

[job75]

Re : copie de cellule

Bonjour Manu62, le forum,

Voyez le fichier joint et cette unique macro affectée aux boutons :

Sub Formule()
If IsError(Application.Caller) Or Not Intersect(ActiveCell, [A1:A2]) Is Nothing Then Exit Sub
ActiveCell = IIf(ActiveSheet.DrawingObjects(Application.Caller).Text = "form 1", [A1], [A2]).Formula
End Sub

Bonne journée.

 

[phlaurent55]

Re : copie de cellule

Bonjour Manu,

avec ce code:

Sub Copie_Formule()
If ActiveCell.Address = "$A$10" Then
    Range("A1").Copy
    Selection.PasteSpecial Paste:=xlPasteFormulas
Else
    Range("A2").Copy
    Selection.PasteSpecial Paste:=xlPasteFormulas
End If
Application.CutCopyMode = False
End Sub

à+
Philippe

Edit: Bonjour Job

 

[job75]

Re : copie de cellule

Re, bonjour Philippe,

Fichier (2) avec un nombre quelconque de boutons :

Sub Formule()
If IsError(Application.Caller) Or Not Intersect(ActiveCell, [A1:A5]) Is Nothing Then Exit Sub
ActiveCell = Cells(Split(ActiveSheet.DrawingObjects(Application.Caller).Text)(1), 1).Formula
End Sub

A+

 

[job75]

Re : copie de cellule

Re,

On peut utiliser des boutons ActiveX avec un Module de classe.

L'inconvénient c'est que la classe doit être initialisée.

Par exemple en modifiant la sélection dans le fichier joint.

A+

 

[Si...]

Re : copie de cellule

salut

pour 2 formules, un bouton bascule pourrait faire l'affaire.

Private Sub ToggleButton1_Click()
 ToggleButton1.Caption = IIf(ToggleButton1.Caption = "copie de F1", "copie de F2", "copie de F1")
 [A10].FormulaLocal = IIf(ToggleButton1, [A2].FormulaLocal, [A1].FormulaLocal)
 'avec un peu de couleur
  [A10].Interior.Color = IIf(ToggleButton1, [A2].Interior.Color, [A1].Interior.Color)
End Sub

 

[Manu62]

Re : copie de cellule

Bonjour,
Merci de vos réponses, j'y suis presque.
ci joint un fichier avec le résultat attendu et un peu plus de précisions.
Merci de votre aide
Manu

 

[job75]

Re : copie de cellule

Re Manu62, salut Si...,

On ne peut pas dire que vous vous donnez du mal pour adapter les solutions qu'on vous donne.

Ma solution du post #2 devient donc :

Sub Formule()
If IsError(Application.Caller) Or Not Intersect(ActiveCell, [E1:E2]) Is Nothing Then Exit Sub
ActiveCell = IIf(ActiveSheet.DrawingObjects(Application.Caller).Text = "formule 1", [E1], [E2]).FormulaR1C1
End Sub

Fichier joint.

A+

 

[Manu62]

Re : copie de cellule

SAlut
J'ai pas du tout regardé
merci bcp c'est nikel
Manu

 

[Manu62]

Re : copie de cellule

bonjour,
J'ai ajouté un $ devant ma cellule. du coup ma formule fonctionne plus ! (SI(ESTNA(RECHERCHEV($D1;TABLEAU;2;FAUX()));0;RECHERCHEV($D1;TABLEAU;2;FAUX()))

le resultat devient
SI(ESTNA(RECHERCHEV(RC4;TABLEAU;2;FAUX()));0;RECHERCHEV(RC4;TABLEAU;2;FAUX()))
au lieu de
SI(ESTNA(RECHERCHEV($D17;TABLEAU;2;FAUX()));0;RECHERCHEV($D17;TABLEAU;2;FAUX()))

Avez vous une idée

Merci d'avance !

Manu

 

[job75]

Re : copie de cellule

Re,

Vous vous fatiguez pour pas grand-chose Manu62.

Vous devriez savoir qu'ici l'utilisation de boutons/formules n'est pas la panacée.

Une solution très classique avec une macro évènementielle :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, v As Variant
With [numero] 'nom défini
  Set r = Intersect(Target, .Offset(1).Resize(Rows.Count - .Row), Me.UsedRange)
End With
If r Is Nothing Then Exit Sub
For Each r In r 'si entrées multiples
  v = Application.VLookup(r, [TABLEAU], 2, 0)
  If IsError(v) Then v = Application.VLookup(r, [TABLEAU2], 2, 0)
  r(, 2) = IIf(IsError(v), "", v)
Next
End Sub

Fichier (2).

A+

 

[Manu62]

Re : copie de cellule

Bonjour,
En fait je voulais mettre un $ car je copie la formule sur le droite 3 fois, et dans ma recherche je change juste le n° de la colonne.
pour cela il faut que je mette le $...
le code juste avant m'aller très bien je pensais qu'il fallait changé juste un élément dans le .formula mais j'ai pas trouvé.
votre dernier code j'ai pas compris.
Merci de votre aide en tout cas
Manu

 

[job75]

Re : copie de cellule

En fait je voulais mettre un $ car je copie la formule sur le droite 3 fois

Si vos tableaux sources ont 4 colonnes, vous pouvez utiliser :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, i As Variant, j As Variant
With [numero] 'nom défini
  Set r = Intersect(Target, .Offset(1).Resize(Rows.Count - .Row), Me.UsedRange)
End With
If r Is Nothing Then Exit Sub
For Each r In r 'si entrées multiples
  i = Application.Match(r, [TABLEAU].Columns(1), 0)
  j = Application.Match(r, [TABLEAU2].Columns(1), 0)
  If IsNumeric(i) Then
    r(, 2).Resize(, 3) = [TABLEAU].Cells(i, 2).Resize(, 3).Value
  ElseIf IsNumeric(j) Then
    r(, 2).Resize(, 3) = [TABLEAU2].Cells(j, 2).Resize(, 3).Value
  Else
    r(, 2).Resize(, 3) = ""
  End If
Next
End Sub

Fichier (3).

A+

 

[job75]

Re : copie de cellule

Re,

Quand même pour régler ceci :

le resultat devient
SI(ESTNA(RECHERCHEV(RC4;TABLEAU;2;FAUX()));0;RECHERCHEV(RC4;TABLEAU;2;FAUX()))

Sub Formule()
If IsError(Application.Caller) Or Not Intersect(ActiveCell, [E1:E2]) Is Nothing Then Exit Sub
ActiveCell.FormulaR1C1 = IIf(ActiveSheet.DrawingObjects(Application.Caller).Text = "formule 1", [E1], [E2]).FormulaR1C1
End Sub

A+