copier une cellule dans une autre ,selon la valeur d'une cellule se trouvant dans une

[yvon07]

bonjour a tous
après de multiple recherche et essais, je n'arrive pas a avoir le résultat .
copier une cellule dans une autre ,selon la valeur d'une cellule se trouvant dans une autre feuille, et ceci a la suite d'une macro de trie.
lorsque je trie avec bouton trier,
si la cellule A27 feuille donnée VH non vide
alors copier feuille inter cellule R3 en cellule G3
macro a mettre a la suite de la macro trier
Merci de votre aide

 

[job75]

Re : copier une cellule dans une autre ,selon la valeur d'une cellule se trouvant dan

Bonjour yvon07,

Effectivement ce n'est pas très simple :

Sub CopieCellule()
Dim celtest As Range, source As Range, dest As Range
Dim s As Shape, i As Byte
'---définitions à adapter---
Set celtest = Sheets("Donnée VH").[A27]
Set source = Sheets("Inters").[R3]
Set dest = Sheets("Inters").[G3].MergeArea
If celtest <> "" Then
  '---RAZ---
  For Each s In dest.Parent.Shapes
    If s.TopLeftCell.MergeArea.Address = dest.Address Then s.Delete
  Next
  '---copie---
  dest.UnMerge 'en cas de cellule fusionnée
  source.Copy dest(1)
  dest.Merge
  '---bordures du contour---
  For i = 7 To 10
    dest.Borders(i).LineStyle = xlDouble
    dest.Borders(i).Color = vbRed
  Next
End If
End Sub

A+

 

[job75]

Re : copier une cellule dans une autre ,selon la valeur d'une cellule se trouvant dan

Re,

Si par exemple les cellules G3 et H3 sont fusionnées on peut vouloir centrer horizontalement le contenu :

Sub CopieCellule()
Dim celtest As Range, source As Range, dest As Range
Dim s As Shape, i As Byte
'---définitions à adapter---
Set celtest = Sheets("Donnée VH").[A27]
Set source = Sheets("Inters").[R3]
Set dest = Sheets("Inters").[G3].MergeArea
If celtest <> "" Then
  '---RAZ---
  For Each s In dest.Parent.Shapes
    If s.TopLeftCell.MergeArea.Address = dest.Address Then s.Delete
  Next
  '---copie---
  dest.UnMerge 'en cas de cellule fusionnée
  source.Copy dest(1)
  dest.Merge
  '---centrage horizontal---
  dest.HorizontalAlignment = xlCenter
  For Each s In dest.Parent.Shapes
    If s.TopLeftCell.MergeArea.Address = dest.Address Then _
      s.Left = dest.Left + (dest.Width - s.Width) / 2
  Next
  '---bordures du contour---
  For i = 7 To 10
    dest.Borders(i).LineStyle = xlDouble
    dest.Borders(i).Color = vbRed
  Next
End If
End Sub

A+

 

[yvon07]

Re : copier une cellule dans une autre ,selon la valeur d'une cellule se trouvant dan

bonsoir
merci de votre aide
j'ai intégré la macro dans mon fichier a la suite de ma macro trier
mais lorsque je fait trier, une erreur de compilation apparaît, en surlignant en bleu " i As Byte"
si je lance la macro seul ca fonctionne, seulement j'aimerai quelle se lance a la suite de la macro trier
Encore merci a vous
A plus

 

[job75]

Re : copier une cellule dans une autre ,selon la valeur d'une cellule se trouvant dan

Re,

Si vous mettez le code à la suite de la macro trier, il est évident qu'il ne faut pas déclarer une 2ème fois la variable i puisqu'elle est déjà déclarée As Integer.

Mais il me paraît plus judicieux de laisser la 2ème macro telle quelle et de l'appeler à la fin de la 1ère :

'---------
End With
CopieCellule
End Sub

A+

 

[yvon07]

Re : copier une cellule dans une autre ,selon la valeur d'une cellule se trouvant dan

bonjour
quand je teste avec le fichier essais fourni ,tous fonctionne.
mais quand je met sur le fichier final , la macro se lance pas.
j'a adapter
Set celtest = Sheets("Donnée VH").[A67] => cellule a tester
Set source = Sheets("Inters").[Q8] => cellule a copier
Set dest = Sheets("Inters").[G8].MergeArea => cellule de dest

Bien mis :CopieCellule
entre :
End With
End Sub
a la fin de ma macro trier.
même après une bonne nuit de sommeil , comprend pas ou est le pb.
Mes Salutations , et bon dimanche.

 

[job75]

Re : copier une cellule dans une autre ,selon la valeur d'une cellule se trouvant dan

Bonjour yvon07,

Il y a un Exit Sub dans la macro trier, c'est sans doute pour ça.

Modifiez la fin de la macro avec CopieCellule en 2 endroits :

'-----------
           '---cadrage---
           Set o = .Shapes("MaJolieShape")
           o.Left = cible.Left + (cible.Width - o.Width) / 2
           CopieCellule
           Exit Sub
         End If
       Next
     End If
   Next
   cible.Merge
 End With
CopieCellule
End Sub

A+

 

[yvon07]

Re : copier une cellule dans une autre ,selon la valeur d'une cellule se trouvant dan

bonjour Job75
ceci fonctionne
par contre je viens de voir, que en cellule de destination G8 il peu y avoir la cellule A59 ou A67.
peu t'on modifier la macro ,pour que si il y les deux ref,un message sois envoyer.
Salutations
A plus

 

[job75]

Re : copier une cellule dans une autre ,selon la valeur d'une cellule se trouvant dan

Re,

Au lieu de joindre des fichiers différents pour chaque problème que vous découvrez, mettez en un seul qui fonctionnera avec toutes les macros que je vous donne.

Et exposez clairement votre dernier problème, je n'ai rien compris.

A+

 

[yvon07]

Re : copier une cellule dans une autre ,selon la valeur d'une cellule se trouvant dan

bonsoir
Désolé pas toujours évident d'expliquer ce que l'on veut.
j'ai essayer d'expliquer mon pb dans la pièce jointe.
En espérant avoir été plus claire.
A+

 

[job75]

Re : copier une cellule dans une autre ,selon la valeur d'une cellule se trouvant dan

Re,

Vous aviez écrit ça, il n'y a rien dans ces cellules :

par contre je viens de voir, que en cellule de destination G8 il peu y avoir la cellule A59 ou A67.

Par ailleurs la macro Enregistrer ne fonctionne pas.

Dans ces conditions je n'irai pas plus loin.

 

[yvon07]

Re : copier une cellule dans une autre ,selon la valeur d'une cellule se trouvant dan

bonsoir
chez moi la macro fonctionne, elle trie, puis me lance bien la macro "copiecellule".


lorsque je trie , il peu arriver que la réf "t853010000" soit présente ainsi que"500300650"
ces deux références, vont en cellule "G4",la réf t853010000 est copier de la feuille donnée VH en A8
l'autre réf est copier par la macro "copiecellule"
dans le cas ou j'ai les deux, cas rare,
j'aimerai afficher un message du type

si quelqu'un peu m'aider.
encore merci a vous JOB75