Xxx

[CMoa]

Bonjour à tous
Décidément je ne suis pas fait pour ces colonnes et ces boucles.
Je cherche désespérément à faire une boucle sur la colonne "P" et lorsque une cellule contient un "X" copier la cellule C et C adress.cell;B et B adress.cell...
Exemple:
si P3 contient un X copier C3 ;B3 et O3 sur une autre feuille et passer à la suite(P4.....

je ne sais si je suis clair ?.Voir le fichier joint + explicite.
Merci pour votre aide

 

[Guest]

Re : Xxx

Bonsoir,

visiblement tu n'est pas fait non plus pour les titres de discussions.

[Edit] y'a même pas un bout d'essai dans ton fichier...je passe mon chemin
A+

 

[Paritec]

Re : Xxx

Bonjour Cmoa, le forum
ton fichier en retour cliques sur le bouton
a+
Papou

EDIT Bonsoir Hasco

 

[CMoa]

Re : Xxx

Bonjour Hasco:
Voici le fichier avec un début de macro qui ne me sert à rien et je pense qu'à toi non plus puisqu'elle ne fonctionne pas.
J'ai essayé d'adapter une macro fournie par tototiti2008 sans succès.
Merci pour ta réponse et les chemins sont nombreux et variés ici bas.

 

[CMoa]

Re : Xxx

Bonsoir Paritec
Merci pour ta réponse qui est plus que complète puisque les couleurs n'étaient là que pour la lisibilité et la compréhension de mon soucis.
C'est parfait: merci beaucoup et @+

 

[Gael]

Re : Xxx

Bonsoir à tous,

Une réponse similaire à celle de Paritec, sans les couleurs mais avec les formules de liaison.

Tu pourras compiler les 2.

@+

Gael

 

[CMoa]

Re : Xxx

Re Gael
Merci pour l'alternative mais je vais opter pour la macro de Paritec dans un soucis de poids du fichier car j'ai plus de 500 lignes à traîter.
Merci beaucoup.
Au plaisir
@+

 

[CMoa]

Re : Xxx

Re
Cette macro fonctionne à merveille mais elle ne garde pas les données sur la feuille 2.
A chaque nouveau changement,elle remplace le contenu des cellules.
Comment la modifier pour que les données se rajoutent les uns à la suite des autres?
Merci

 

[Compte Supprimé 979]

Re : Xxx

Bonsoir le fil,

Cmoa, comme l'a dis Hasco, merci de bien vouloir mettre un TITRE EXPLICITE la prochaine fois

Pour le code recherché, MERCI à Gael pour le début ...
essaye ceci

Sub copie()
  Dim Cell As Range, Ligne As Long
  For Each Cell In Range("P1:P" & Range("P100").End(xlUp).Row)
    If Cell.Value = "X" Then
      With Worksheets("Feuil2")
        ' Trouver la dernière ligne remplie de la feuille 2
        Ligne = .Range("H" & Rows.Count).End(xlUp).Row
        ' Si inférieure à 4 alors 4
        If Ligne < 4 Then Ligne = 4
        ' Compléter la feuille
        .Cells(Ligne, 8).Formula = "=Feuil1!C" & Cell.Row
        .Cells(Ligne, 9).Formula = "=Feuil1!B" & Cell.Row
        .Cells(Ligne, 10).Formula = "=Feuil1!O" & Cell.Row
        ' [COLOR=red]Ligne = Ligne + 1 '= A SUPPRIMER[/COLOR]
      End With
    End If
  Next
End Sub

A+

 

[CMoa]

Re : Xxx

Bonsoir BrunoM45
Merci pour ta réponse.
Elle ne me convient pas non plus puisqu'elle renvoie une formule dans une cellule donnée.
Les valeurs de départ peuvent varier ce qui fait qu'une formule n'est pas appropriée.
Par contre je me suis permis de modifier ta macro mais je me suis apperçu qu'elle les valeurs au même endroit.
exemple:
P3 =X
P4=X
Le résultat est la valeur de P4(C3).
Voici la macro modifiée:

Sub copieword()
  Dim Cell As Range, Ligne As Long
  For Each Cell In Range("P1:P" & Range("P100").End(xlUp).Row)
    If Cell.Value = "X" Then
      With Worksheets("Récapitulatif")
        ' Trouver la dernière ligne remplie de la feuille 2
        Ligne = .Range("H" & Rows.Count).End(xlUp).Row
        ' Si inférieure à 4 alors 4
        If Ligne < 4 Then Ligne = 4
        ' Compléter la feuille
        .cells(Ligne, 8) = Sheets("Devis Word").Range("C" & Cell.Row) '"=Feuil1!C" & Cell.Row
        .cells(Ligne, 9) = Sheets("Devis Word").Range("B" & Cell.Row) '"=Feuil1!B" & Cell.Row
        .cells(Ligne, 10) = Sheets("Devis Word").Range("O" & Cell.Row) '"=Feuil1!O" & Cell.Row
        .cells(Ligne, 11) = Sheets("Récapitulatif").Range("K3") & " " & Now
        Ligne = Ligne + 1
      End With
    End If
  Next
End Sub

Merci de voir si je ne me suis pas trompé dans la modif.
Pour le titre rien de plus explicite puisqu'il s'agit de récupérer des valeurs en fonction des X
@+

 

[Compte Supprimé 979]

Re : Xxx

Re,

Je n'ai rien changé au code de Gael puisque plus haut tu nous dis

Cette macro fonctionne à merveille mais elle ne garde pas les données sur la feuille 2.
A chaque nouveau changement,elle remplace le contenu des cellules.
Comment la modifier pour que les données se rajoutent les uns à la suite des autres?

Donc j'ai juste rajouter les lignes pour qu'à chaque fois cela vienne s'ajouter et non remplacer !

Supprimer : ligne = ligne + 1

A+

 

[CMoa]

Re : Xxx

Re
Désolé pour la confusion mais en fait j'avais opté pour la macro faite pa Paritec .

Merci pour l'alternative mais je vais opter pour la macro 
de Paritec dans un soucis de poids du fichier car j'ai plus de 500
 lignes à traîter.

cette macro fonctionne mais inscrit les résultats obtenus à partir de H4:K4.
Si je change de X la valeur est tjrs inscrite à partir de H4:K4
@+

 

[Gael]

Re : Xxx

Re,

Bruno, je pense que Cmoi voulait parler de la macro de Paritec.

Sinon cela devrait marcher comme cela:

Sub copieword()
  Dim Cell As Range, Ligne As Long
  
  ' Trouver la dernière ligne remplie de la feuille 2
        Ligne = Worksheets("Récapitulatif").Range("H" & Rows.Count).End(xlUp).Row
        ' Si inférieure à 4 alors 4
        If Ligne < 4 Then Ligne = 4
  For Each Cell In Range("P1:P" & Range("P100").End(xlUp).Row)
    If Cell.Value = "X" Then
        With Worksheets("Récapitulatif")
        ' Compléter la feuille
        .Cells(Ligne, 8) = Sheets("Devis Word").Range("C" & Cell.Row) '"=Feuil1!C" & Cell.Row
        .Cells(Ligne, 9) = Sheets("Devis Word").Range("B" & Cell.Row) '"=Feuil1!B" & Cell.Row
        .Cells(Ligne, 10) = Sheets("Devis Word").Range("O" & Cell.Row) '"=Feuil1!O" & Cell.Row
        .Cells(Ligne, 11) = Sheets("Récapitulatif").Range("K3") & " " & Now
        Ligne = Ligne + 1
      End With
    End If
  Next
End Sub

@+

Gael

 

[CMoa]

Re : Xxx

Re
Je pense sous toute réserve que j'ai trouvé le hic:

' Trouver la dernière ligne remplie de la feuille 2
       Ligne = Worksheets("Récapitulatif").Range("H" & Rows.Count).End(xlUp).Row [COLOR="Red"]+ 1[/COLOR]

j'ai aussi supprimé le test

' Si inférieure à 4 alors 4
        If Ligne < 4 Then Ligne = 4

et il semblerait que cela fonctionne ??

Bonne soirée
Merci pour votre aide