Sujet Précédent Sujet Suivant

Macro excel "tri de ligne et copie vers feuil3"

Résolu
psykocoic Messages postés 24 Date d'inscription samedi 4 décembre 2004 Statut Membre Dernière intervention 6 juin 2007 - 19 mai 2007 à 18:24
psykocoic Messages postés 24 Date d'inscription samedi 4 décembre 2004 Statut Membre Dernière intervention 6 juin 2007 - 1 juin 2007 à 13:40
bonjour à tous.


tout novice dans la création de macro, je galère... bref...


je bosse sur un tableau de suivi médical avec des alertes visuelles. tout ça fonctionne pas mal, sans macro. j'ai bossé avec des mises en formes conditionnelles et des fonctions SI, OU et ET, principalement.


je souhaite aller plus loin et extraire des cellules dans les lignes comprenant des alertes (en gros, et pour commencer, il y a alerte lorsque la cellule a une valeur inférieure à zéro).


ces cellules extraites, je souhaite les copier vers une autre feuille du meme classeur, histoire de faire un listing clair des personnes ayant une alerte sur leur dossier.


j'espère que vous me suivez.


voici le code que j'ai réussi à monter, avec des recherches sur le net...




1. Sub test()
2.
3. Sheets("CS").Select
4. Dim lig
5. lig = 12
6. For lig = 12 To 43
7. If Cells(lig, 1) < 0 Then
8. Range(Cells(lig, 4), Cells(lig, 5)).Select
9. selection.Copy
10. Sheets("Feuil3").Select
11. Range("C7").Select
12. ActiveSheet.Paste
13. End If
14. Next lig
15.
16. End Sub


j'arrive, avec ce code à extraire des cellules de la première ligne ayant une alerte visuelle... mais les autres, impossible...


Merci de ce que vous pourrez m'apporter comme éléments de réponse.

34 réponses

Précédent
  • 1
  • 2
Réponse 21 / 34
mortalino Messages postés 6786 Date d'inscription vendredi 16 décembre 2005 Statut Membre Dernière intervention 21 décembre 2011 18
23 mai 2007 à 04:09
Salut,

désolé, j'ai vu ton mail mais je n'ai pas eu le temps de m'y pencher
Promis, je regarderai aujourd'hui (je bosse à 14h, j'y jetterai un oeil, là c'est dodo)

@++

<hr size="2" width="100%" />
  --Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~
  
0
Réponse 22 / 34
psykocoic Messages postés 24 Date d'inscription samedi 4 décembre 2004 Statut Membre Dernière intervention 6 juin 2007
23 mai 2007 à 05:15
hum... dsl. j'ai pas réussi à intégrer les balises "code"...
j'avais réussi pourtant la dernière fois...

bref, voici les codes avec numérotation des lignes (à la main...)

1.Sub triVMA()
2.
3.Dim lig As Long
4.Dim compteur As Long

5.compteur = 7
6.For lig = 12 To 43
7.    Sheets("CS").Select
8.    If Cells(lig, 2) < 0 Then
9.        Range(Cells(lig, 5), Cells(lig, 6)).Select
10.        Selection.Copy
11.       Sheets("suivi").Select
12.        compteur = compteur + 1
13.       Range("D" & compteur).PasteSpecial
14.   End If
15.Next lig

16.Sheets("suivi").Select

17.End Sub

<hr />
1.Sub Message2()
2.   Dim Retour As String
3.  
4.' je place l'utilisateur sur la page CS pour avoir la liste sous les yeux.5.Sheets("CS").Select

6.' je fais apparaitre le formulaire de choix

7.   Retour = InputBox("Numéro attribué au SP :", "Veuillez rensigner le champs", 8."Entrez le numéro souhaité")

9.'si choix de la ligne n°1
10.   If Retour = "1" Then
11.' on copie groupement et CIS, ces cellules sont toujours les mêmes
12.  Sheets("fiche").Select
13.Range("E7").Value = Sheets("CS").Range("E3").Value
14.   Sheets("fiche").Select
15.Range("E8").Value = Sheets("CS").Range("E4").Value

16.
17.' on copie le nom, prénom
18.   Sheets("fiche").Select
19.Range("C5").Value = Sheets("CS").Range("E12").Value
20.' on copie la date de naissance
21.    Sheets("fiche").Select
22.Range("F11").Value = Sheets("CS").Range("F12").Value
23.' on copie Dernier DTP
24.    Sheets("fiche").Select
26.Range("F13").Value = Sheets("CS").Range("X12").Value
27.' on copie Prochain DTP
28.    Sheets("fiche").Select
29.Range("F14").Value = Sheets("CS").Range("O12").Value
30.' on copie premier VHB
31.    Sheets("fiche").Select
32.Range("F16").Value = Sheets("CS").Range("Y12").Value
33.' on copie Second VHB
34.    Sheets("fiche").Select
35.Range("F17").Value = Sheets("CS").Range("Z12").Value
36.' on copie Troisième VHB
37.    Sheets("fiche").Select
38.Range("F18").Value = Sheets("CS").Range("AA12").Value
39.' on copie délai par défaut VMA
40.    Sheets("fiche").Select
41.Range("F23").Value = Sheets("CS").Range("P12").Value
42.' on copie délai corrigé VMA
43.    Sheets("fiche").Select
44.Range("F24").Value = Sheets("CS").Range("Q12").Value
45.' on copie date bio
46.    Sheets("fiche").Select
47.Range("F29").Value = Sheets("CS").Range("H12").Value
48.' on copie la sérologie
49.    Sheets("fiche").Select
50.Range("F20").Value = Sheets("CS").Range("M12").Value
51.' on copie la date de sérologie
52.    Sheets("fiche").Select
53.Range("F21").Value = Sheets("CS").Range("N12").Value
54.' on copie date derniere VMA
55.    Sheets("fiche").Select
56.Range("F26").Value = Sheets("CS").Range("W12").Value
57.' on copie date prochaine VMA
58.    Sheets("fiche").Select
59.Range("F27").Value = Sheets("CS").Range("T12").Value
60.' on copie date dernière biologie
61.    Sheets("fiche").Select
62.Range("F29").Value = Sheets("CS").Range("H12").Value
63.' on copie date dernier ECG
64.    Sheets("fiche").Select
65.Range("F30").Value = Sheets("CS").Range("I12").Value
66.' on copie date derniere Rx Pulm.
67.    Sheets("fiche").Select
68.Range("F31").Value = Sheets("CS").Range("J12").Value
69.' on copie date dernier visite cardio
70.    Sheets("fiche").Select
71.Range("F32").Value = Sheets("CS").Range("K12").Value
72.' on copie observation
73.    Sheets("fiche").Select
74.Range("E34").Value = Sheets("CS").Range("G12").Value
75.' on copie date dernier vaccin fievre jaune
76.    Sheets("fiche").Select
77.Range("F38").Value = Sheets("CS").Range("AD12").Value
78.' on copie date dernier vaccin rage
79.    Sheets("fiche").Select
80.Range("F37").Value = Sheets("CS").Range("AF12").Value
81.' on copie date dernier vaccin Hep A
82.    Sheets("fiche").Select
83.Range("F39").Value = Sheets("CS").Range("AE12").Value
84.' on copie date dernier vaccin Typhim
85.    Sheets("fiche").Select
86.Range("F36").Value = Sheets("CS").Range("AG12").Value
87.   End If

88.
89.'si choix de la ligne n°2
90.   If Retour = "2" Then
91.' on copie groupement et CIS, ces cellules sont toujours les mêmes
92.   Sheets("fiche").Select
93.Range("E7").Value = Sheets("CS").Range("E3").Value
94.   Sheets("fiche").Select
95.Range("E8").Value = Sheets("CS").Range("E4").Value

96.
97.' on copie le nom, prénom
98.   Sheets("fiche").Select
99.Range("C5").Value = Sheets("CS").Range("E13").Value
100.' on copie la date de naissance
101.    Sheets("fiche").Select
102.Range("F11").Value = Sheets("CS").Range("F13").Value
103.' on copie Dernier DTP
104.    Sheets("fiche").Select
105.Range("F13").Value = Sheets("CS").Range("X13").Value
106.' on copie Prochain DTP
107.    Sheets("fiche").Select
108.Range("F14").Value = Sheets("CS").Range("O13").Value
109.' on copie premier VHB
110.    Sheets("fiche").Select
111.Range("F16").Value = Sheets("CS").Range("Y13").Value
112.' on copie Second VHB
113.    Sheets("fiche").Select
114.Range("F17").Value = Sheets("CS").Range("Z13").Value
115.' on copie Troisième VHB
116.    Sheets("fiche").Select
117.Range("F18").Value = Sheets("CS").Range("AA13").Value
118.' on copie délai par défaut VMA
119.    Sheets("fiche").Select
120.Range("F23").Value = Sheets("CS").Range("P13").Value
121.' on copie délai corrigé VMA
122.    Sheets("fiche").Select
123.Range("F24").Value = Sheets("CS").Range("Q13").Value
124' on copie date bio
125.    Sheets("fiche").Select
126.Range("F29").Value = Sheets("CS").Range("H13").Value
127.' on copie la sérologie
128.    Sheets("fiche").Select
129.Range("F20").Value = Sheets("CS").Range("M13").Value
130.' on copie la date de sérologie
131.    Sheets("fiche").Select
132.Range("F21").Value = Sheets("CS").Range("N13").Value
133.' on copie date derniere VMA
134.    Sheets("fiche").Select
135.Range("F26").Value = Sheets("CS").Range("W13").Value
136.' on copie date prochaine VMA
137.   Sheets("fiche").Select
138.Range("F27").Value = Sheets("CS").Range("T13").Value
139.' on copie date dernière biologie
140.    Sheets("fiche").Select
141.Range("F29").Value = Sheets("CS").Range("H13").Value
142.' on copie date dernier ECG
143.    Sheets("fiche").Select
144.Range("F30").Value = Sheets("CS").Range("I13").Value
145.' on copie date derniere Rx Pulm.
146.    Sheets("fiche").Select
147.Range("F31").Value = Sheets("CS").Range("J13").Value
148.' on copie date dernier visite cardio
149.    Sheets("fiche").Select
150.Range("F32").Value = Sheets("CS").Range("K13").Value
151.' on copie observation
152.    Sheets("fiche").Select
153.Range("E34").Value = Sheets("CS").Range("G13").Value
154.' on copie date dernier vaccin fievre jaune
155.    Sheets("fiche").Select
156.Range("F38").Value = Sheets("CS").Range("AD13").Value
157.' on copie date dernier vaccin rage
158.    Sheets("fiche").Select
159.Range("F37").Value = Sheets("CS").Range("AF13").Value
160.' on copie date dernier vaccin Hep A
161.    Sheets("fiche").Select
162.Range("F39").Value = Sheets("CS").Range("AE13").Value
163.' on copie date dernier vaccin Typhim
164.    Sheets("fiche").Select
165.Range("F36").Value = Sheets("CS").Range("AG13").Value
166.   End If
167.  
168.' ... ... ... 
169. 
170.End Sub
0
Réponse 23 / 34
psykocoic Messages postés 24 Date d'inscription samedi 4 décembre 2004 Statut Membre Dernière intervention 6 juin 2007
23 mai 2007 à 05:18
merci bcp mortalino.

te biles pas. je ne suis pas à la tache, je postais ici simplement pour trouver d'autres idées, au cas où et ne pas faire toujours appel à toi (qui en a peut-être un peu marre de me voir rabouler...)

bonne journée. moi, je finis le taf à 7h... et dodo jusque 14h surement.. je verrais vos réponses après.

MErci à tous !
0
Réponse 24 / 34
psykocoic Messages postés 24 Date d'inscription samedi 4 décembre 2004 Statut Membre Dernière intervention 6 juin 2007
25 mai 2007 à 10:59
juste un mesaage pour vous dire que j'ai résolu le pb des "petits" code de ce type :

Sub triVMA()





               Dim lig As Long
               Dim compteur As Long




               compteur = 7
               For lig = 12 To 43
                   Sheets("CS").Select
                   If Cells(lig, 2) < 0 Then
                       Range(Cells(lig, 5), Cells(lig, 6)).Select
                       Selection.Copy
                       Sheets("suivi").Select
                       compteur = compteur + 1
                       Range("D" & compteur).PasteSpecial
                   End If
               Next lig




               Sheets("suivi").Select




               End Sub





en fait, les codes n'était pas en cause. c'était mes cellules à contrôler qui avait des erreurs... et en corrigeant mes fonctions SI et OU... j'ai résolu le pb.

reste que le problème de l'autre code dont je ne trouve pas de solution...

merci à celui qui aurait une idée.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 25 / 34
psykocoic Messages postés 24 Date d'inscription samedi 4 décembre 2004 Statut Membre Dernière intervention 6 juin 2007
27 mai 2007 à 01:46
Bonjour à tous.

un petit message pour relancer.

Mortalino, as-tu eu le temps de voir comment je pourrais faire ?

Les autres ? auriez vous des idées ? j'ai beau chercher, faire des essais et autre creusage de tête... je sèche à mort...

merci.
0
Réponse 26 / 34
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
27 mai 2007 à 13:50
Je ne sais pas trop où est ton problème, mais tu pourrais alléger ton code un peu, je pense.
Les lignes 17 à 87 et les lignes 97 à 166 semblent être les mêmes à l'exception du Range("XYZ 12 ou 13")

Si c'est bien cela, tu pourrais te servir du numéro de retour de ton InputBox pour incrémenter la cellule visée
ex:
17.' on copie le nom, prénom
18.   Sheets("fiche").Select19.Range("C5").Value Sheets("CS").Range(" E12 ").Value  '<
équivaut à dire E11 + la valeur de retour
Si on entre 1 dans l'InputBox => range("E11") + 1  => range("E12")
Si on entre 2 dans l'InputBox => range("E11") + 2  => range("E13")

Ce qui donnerait
Range("C5") = Sheets("CS").Range("E11").Offset(CInt(Retour), 0)

Offset() déplace le curseur (change la ligne dans ce cas-ci)
CInt(Retour) force la variable String en Integer

Mis à part cette parenthèse que je me suis permise, pourrais-tu expliquer où exactement tu as des problèmes ?

Ne serait-ce pas possible pour toi de faire un filtre sur la colonne contenant les valeurs d'alerte et copier d'un bloc toutes ces données ?

MPi
0
Réponse 27 / 34
psykocoic Messages postés 24 Date d'inscription samedi 4 décembre 2004 Statut Membre Dernière intervention 6 juin 2007
27 mai 2007 à 17:05
MErci de ta réponse !

en fait, cette ayant été calme au boulot, j'ai pu retravailler sur le code.

et réussir à faire un truc qui fonctionne. mais en effet ,comme tu le dis, le code n'est pas très beau... c'est le pb des débutant je pense.

je remets une partie du code ici pour vous montrer :
0
Réponse 28 / 34
psykocoic Messages postés 24 Date d'inscription samedi 4 décembre 2004 Statut Membre Dernière intervention 6 juin 2007
28 mai 2007 à 01:44
bon... j'ai rebossé mon code et je pense que j'avais commencé à faire ce que tu m'as proposé.

je remets le code :

---------

Sub ficheindividuelle()




Sheets("CS").Select
ligne = InputBox("Numéro attribué au SP :", "Création de fiche individuelle", "Entrez le numéro souhaité")


'rechercher la valeur
Sheets("CS").Select
Columns("A:A").Select
'Définie la valeur à rechercher
'ficCARTE$ = tbCARTE.Value
'Effectue la recherche
Selection.Find(What:=ligne, After:=ActiveCell).Select


ActiveCell.Offset(0, 4).Range("A1").Select
' on vérifie si la cellule nom,prenom est rempli
If ActiveCell <> "" Then
' on copie Nom, Prénom
    Sheets("fiche").Range("D5") = ActiveCell.Value
    Sheets("CS").Select


' on copie Date de naissance
ActiveCell.Offset(0, 1).Range("A1").Select
    Sheets("fiche").Range("F11") = ActiveCell.Value
    Sheets("CS").Select
   
' on copie Dernier DTP
ActiveCell.Offset(0, 18).Range("A1").Select
   Sheets("fiche").Range("F13") = ActiveCell.Value
   Sheets("CS").Select

'
'...
'

Else
erreur = MsgBox("Pas de ligne à copier !", vbOKOnly, "Erreur")




End If
End Sub

--------

vous en pensez quoi ? y'a moyen de le nettoyer ?
0
Réponse 29 / 34
cs_MPi Messages postés 3877 Date d'inscription mardi 19 mars 2002 Statut Membre Dernière intervention 17 août 2018 23
28 mai 2007 à 11:33
Si je comprends bien ton problème, tu prends les données d'une ligne (selon le choix de l'utilisateur) et tu copies chaque cellule dans une autre feuille dans un ordre prédéterminé pour faire un genre de présentation de fiche. Tu travailles donc avec 2 feuilles.

Imagine que tes données soient toujours sur la ligne 5
Dans ta fiche, tu pourrais mettre de simples formules RechercheV pour inscrire tes données aux bons endroits.
Le problème étant que l'utilisateur choisit les données à afficher, les formules ne sont pas modifiées pour autant

Je verrais 2 solutions:
1-  Tu inscris le numéro choisi par l'utilisateur dans une cellule de la fiche
     Et tu modifies tes formules de RechercheV en utilisant cette cellule comme valeur de recherche

2- Tu utilises une troisième feuille dans laquelle tu copies toute la ligne de données que l'utilisateur a choisie.
    Et tes formules recherchent dans cette feuille

Dans les 2 cas, ça t'éviterait pas mal de code.
Mais encore une fois, peut-être que j'ai mal compris la base du problème... (?)

PS: ceci ne me semble pas bien écrit: 
    ActiveCell.Offset(0, 4).Range("A1").Select
    La partie en bleu ne devrait pas être là, il me semble ...

MPi
0
Réponse 30 / 34
psykocoic Messages postés 24 Date d'inscription samedi 4 décembre 2004 Statut Membre Dernière intervention 6 juin 2007
28 mai 2007 à 13:15
tu a l'air d'avoir compris ce que je voulais. seulement, je connais pas de rechercheV.

en clair, j'ai un tableau de donnée. j'ai précédé chaque ligne à partir de douzième (dans la colonne A) d'un chiffre (de 1 à ...).

je souhaite que l'utilisateur choisisse l'un de ces chiffres et que la macro copie des cellules de la ligne sélectionnée vers une seconde feuille.

pour cela, j'ai donc fait une inputbox :
0
Réponse 31 / 34
psykocoic Messages postés 24 Date d'inscription samedi 4 décembre 2004 Statut Membre Dernière intervention 6 juin 2007
29 mai 2007 à 13:28
c'est interressant en effet.

mais, je dois copier plus de 20 cells non à la suite... ça marche avec ce type de formule ?

je teste pour commencer à l'amadouer.
0
Réponse 32 / 34
psykocoic Messages postés 24 Date d'inscription samedi 4 décembre 2004 Statut Membre Dernière intervention 6 juin 2007
29 mai 2007 à 13:33
hum... dsl. après test, je comprend mieux et je vois que je peux copier les cells que je veux..

je vais voir.
0
Réponse 33 / 34
valou0202 Messages postés 8 Date d'inscription jeudi 31 mai 2007 Statut Membre Dernière intervention 20 juin 2007
1 juin 2007 à 10:49
Bonjour,
Je sui étudiante et je travail sur Excel, je souhaiterai faire une marco afin de rechercher des information sur la feuille du classeur.

J'espère que vous pourez m'aider.
0
Réponse 34 / 34
psykocoic Messages postés 24 Date d'inscription samedi 4 décembre 2004 Statut Membre Dernière intervention 6 juin 2007
1 juin 2007 à 13:40
Je pense qu'il serait bien pour avoir une réponse que tu fasses ta demande comme décrit sur ce lien :

http://www.vbfrance.com/reglement.aspx
0

Discussions similaires

Dernière cellule non vide d'une colonne
cs_falafala -
Luigi13013 -

5 réponses
Importation données excel vers access
rahmoun111 -
rach_zar -

2 réponses
Différence entre saut de ligne(LF \n) et retour chariot(CR \r)
mickadevelop -
Kysic -

12 réponses
regex et sauts de lignes
tseu83 -
Jleherpeur -

10 réponses
Le saut de ligne \n ne marche pas dans les instructions echo
GIRAFE ENRHUMEE -
Anthomicro -

10 réponses
Rejoignez-nous