Xxx

CMoa · 8 Juillet 2010

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 · 8 Juillet 2010

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 · 8 Juillet 2010

Re : Xxx

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

EDIT Bonsoir Hasco

CMoa · 8 Juillet 2010

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 · 8 Juillet 2010

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 · 8 Juillet 2010

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 · 8 Juillet 2010

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 · 8 Juillet 2010

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 · 8 Juillet 2010

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

Code:

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 · 8 Juillet 2010

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:

Code:

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 · 8 Juillet 2010

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 · 8 Juillet 2010

Re : Xxx

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

Code:

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 · 8 Juillet 2010

Re : Xxx

Re,

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

Sinon cela devrait marcher comme cela:

Code:

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 · 8 Juillet 2010

Re : Xxx

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

Code:

' 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

Code:

' 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

Xxx

CMoa

XLDnaute Occasionnel

Pièces jointes

Guest

Guest

Paritec

XLDnaute Barbatruc

Pièces jointes

CMoa

XLDnaute Occasionnel

Pièces jointes

CMoa

XLDnaute Occasionnel

Gael

XLDnaute Barbatruc

Pièces jointes

CMoa

XLDnaute Occasionnel

CMoa

XLDnaute Occasionnel

Compte Supprimé 979

Guest

CMoa

XLDnaute Occasionnel

Compte Supprimé 979

Guest

CMoa

XLDnaute Occasionnel

Gael

XLDnaute Barbatruc

CMoa

XLDnaute Occasionnel

Discussions similaires

Xxx

XLDnaute Occasionnel

Pièces jointes

Guest

Guest

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

Pièces jointes

XLDnaute Occasionnel

XLDnaute Barbatruc

Pièces jointes

XLDnaute Occasionnel

XLDnaute Occasionnel

Compte Supprimé 979

Guest

XLDnaute Occasionnel

Compte Supprimé 979

Guest

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency