Mise en forme en fonction de la cellule interrogée

0

J'utilise la fonction '=A1' pour recopier la cellule A1 mais je voudrais que cela recopie également la mise en forme de la cellule A1.

exemple : https://www.cjoint.com/c/LKErWF2FVlj

Posté le 30 novembre 2022, 18:49
par Vincent
Répondre
0

Bonjour Vincent,

ce que tu demandes n'est pas possible par formule ; je l'ai donc fait par VBA,
même si je ne vois pas bien l'intérêt de recopier en colonne D les nombres
de la colonne A.

ton fichier en retour : https://www.cjoint.com/c/LLbdQVsngG0

pour chaque nombre de la colonne A que tu veux copier en colonne D
avec la mise en forme : sélectionne la cellule de ce nombre, Ctrl k.

* exemple 1 : tu es en A1 ; fais Ctrl k ➯ ça copie 46 en D1, avec le fond jaune.

* exemple 2 : va en A2 ; fais Ctrl k ➯ ça copie 52 en D2.

* exemple 3 : va en A4 ; fais Ctrl k ➯ ça copie 23 en D4, avec la couleur rouge.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

code VBA de Module1 :

Sub CpyDM()
  'sur une des lignes de la colonne A, copie la donnée avec
  'sa mise en forme 3 colonnes à droite, donc en colonne D.
  With ActiveCell
    If .Column = 1 Then .Copy .Offset(, 3)
  End With
End Sub

rhodo

rhodo Posté le 1 décembre 2022, 04:52
par rhodo
0

@Vincent

voici une 2ème version du fichier : https://www.cjoint.com/c/LLbpFPSkxn0

la cellule active est G1 ; mais quelle que soit la cellule active, Ctrl k copie d'un seul coup tous les nombres de la colonne A en colonne D, avec la mise en forme.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

code VBA de Module1 :

Option Explicit

Sub CpyAD()
  'copie toutes les données de la colonne A en colonne D,
  'avec la mise en forme ; équivalent d'un copier/coller.
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row
  If n = 1 And IsEmpty([A1]) Then Exit Sub
  Application.ScreenUpdating = 0
  [A1].Resize(n).Copy [D1]
End Sub

rhodo

rhodo Posté le 1 décembre 2022, 16:40
par rhodo
0

Merci, oui il n'y a pas d'intérêt de recopier la colonne A en colonne D, mais c'était pour simplifier mon explication. Mon fichier ressemble plutôt à ca : 

https://www.cjoint.com/c/LLbxIOMk3yj

Cela recopie les lignes dans la bonne feuille de calcul en fonction de la valeur de la colonne B de la première feuille. Est-ce donc possible d'avoir la mise en forme avec ?

Merci

Posté le 2 décembre 2022, 00:37
par Vincent
0

Bonjour Vincent,

ton fichier en retour : https://www.cjoint.com/c/LLcejduHz40

à l'ouverture du fichier, tu es sur "Feuil3" ; note qu'il y a 3 en-têtes en A1:C1 ;
aucune donnée ; va sur "Feuil2" ; c'est idem ; va sur "Feuil1" ; j'ai changé
un peu la présentation ; ce sont les mêmes données, avec la même mise
en forme (par exemple fond vert ou texte rouge).

fais Ctrl d (d pour dispatch) ; ça s'est mit sur "Feuil2", et tu peux voir que
toutes les données de "Feuil1" concernant "Feuil2" sont listées ici, avec
la même mise en forme
.

va sur "Feuil3" ; tu peux voir que c'est idem : toutes les données de
"Feuil1" concernant "Feuil3" sont listées ici ; même mise en forme.

quand tu dois réactualiser les données, va sur "Feuil1" et refais Ctrl d ;
c'est inutile d'effacer avant les anciens résultats obtenus en "Feuil2"
et "Feuil3" car c'est fait automatiquement par la macro.

il n'y a aucune formule ; tout est fait par VBA.

------------------------------------------------------------------------------------------------------

code VBA de Module1 :

Option Explicit

Sub Dispatch()
  If ActiveSheet.Name <> "Feuil1" Then Exit Sub
  Dim m&, n&: m = Rows.Count: n = Cells(m, 1).End(3).Row: If n < 4 Then Exit Sub
  Dim f As Byte, i&, j&(2 To 3): Application.ScreenUpdating = 0
  For f = 2 To 3
    With Worksheets(f)
      i = .Cells(m, 1).End(3).Row: If i > 1 Then .Range("A2:C" & i).Clear
    End With
    j(f) = 2
  Next f
  For i = 4 To n
    With Cells(i, 1)
      Select Case .Offset(, 1)
        Case "Feuil2": f = 2
        Case "Feuil3": f = 3
        Case Else: f = 0
      End Select
      If f > 0 Then
        .Resize(, 3).Copy Worksheets(f).Cells(j(f), 1): j(f) = j(f) + 1
      End If
    End With
  Next i
  Worksheets(2).Select
End Sub

------------------------------------------------------------------------------------------------------

si besoin, tu peux demander une adaptation.
à te lire pour avoir ton avis.  :)

rhodo

rhodo Posté le 2 décembre 2022, 05:34
par rhodo
0

Bonjour,

Merci beaucoup ! 

C'est impeccable, je n'ai plus qu'à refaire tout ca adapté à mon cas précis !

Posté le 5 décembre 2022, 20:12
par Vincent

Si vous n'êtes pas inscrit sur le site, vous pouvez poster librement (en tant qu'invité).
Pour cela, indiquez un pseudonyme (nom d'utilisateur) et une adresse email :