macro excel "tri de ligne et copie vers feuil3"Résolu

Question

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.

mortalino · Accepted Answer

Salut, c'est normal, car à chaque passage de ta boucle, il faut reselectiionner la feuille CS. Mais tu peux faire autrement : Sub test() Sheets("CS").Select Dim lig As Long ' n'oublie pas d'indiquer le type de données lig = 12 ' inutile, car tu lui donnes une valeur dans la boucle For lig = 12 To 43 If Cells(lig, 1) < 0 Then Range(Cells(lig, 4), Cells(lig, 5)).Select Selection.Copy 'Sheets("Feuil3").Select Je te le vire car : Sheets("Feuil3").Range("C7").PasteSpecial 'ActiveSheet.Paste ' Paste direct via l'instruction précédante End If Next lig End Sub ~ [code.aspx?ID=39466 Mortalino] ~ Colorisation automatique @++

--Mortalino-- Le mystérieux chevalier, ~Provençal, le Gaulois~

psykocoic · Answer

Merci de ton aide super rapide.

ça a l'air de mieux fonctionner... cependant, encore un soucis.

sur plusieur lignes qu'il devrait me copier, je ne retrouve que la dernière.

est-ce que ça ne copierait pas les uns sur les autres comme ça ?

psykocoic · Answer

hum... autre chose, dsl.

à quoi correspond "long" dans 

"Dim lig As Long"   

merci encore !

mortalino · Answer

Arf, bien vu, voici la correction :

Sub test()

Sheets("CS").Select
Dim lig As Long   ' n'oublie pas d'indiquer le type de données
Dim compteur As Long

compteur =  6
lig = 12  '  inutile, car tu lui donnes une valeur dans la boucle
For lig = 12 To 43
    If Cells(lig, 1) < 0 Then
        Range(Cells(lig, 4), Cells(lig, 5)).Select
        Selection.Copy
        'Sheets("Feuil3").Select    Je te le vire car  :
        compteur = compteur + 1
        Sheets("Feuil3").Cells(compteur, 2).PasteSpecial
        'ActiveSheet.Paste  ' Paste direct via l'instruction  précédante
    End If
Next lig

End Sub

Pour le type Long, c'est du numérique. Regarde dans l'aide, tape  Résumé des types , et tu auras toutes les infos 

@++ 

<hr size ="2" width="100%" />
  --Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~

psykocoic · Answer

je vais tester de suite. merci pour ta rapidité.

je vais aller voir le résumé dont tu parles aussi. ça m'aidera. (surement... lol)

concernant le compteur que tu ajoutes, quand tu mets "compteur=6" cela veut-il dire qu'il va tester 6 lignes, écrire 6 lignes ?

psykocoic · Answer

cela ne fait-il pas trop "léger" de rajouter :

Sheets("feuil3").Select

entre les balises next et end afin qu'en fin de macro je me retrouve sur la feuille que je veux ?

mortalino · Answer

Non, en fait, j'ai vu que tu voulais mettre les données à partir de C7, donc j'initialise le compteur à 6, et avant d'inscrire les données, je fais compteur = compteur + 1 (donc il prend la valeur 7, puis 8, etc..) pour ne pas écraser les données précédantes !

@++ 

<hr size="2" width="100%" />
  --Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~

psykocoic · Answer

merci pour ton explication

mais dsl, mais il écrase toujours. et à bien y regarder, je vois bien les données s'inscrire puis se faire écraser.

mortalino · Answer

Oui, tu peux utiliser le Sheets("feuil3").Select, mais cela t'oblige à utiliser avant le If Cells(lig, 1) < 0 Then
l'instruction suivante : Sheets("CS").Select

Sinon, tu resteras sur Feuil3, et ça ne lira pas les données de la feuille CS 

@++ 

<hr size="2" width="100%" />
  --Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~

psykocoic · Answer

de plus, il ne me mets pas mes données en C7, mais en B7...

mortalino · Answer

Oui, je suis allez trop vite, désolé, essaie cette correction : Sub test() Dim lig As Long ' n'oublie pas d'indiquer le type de données Dim compteur As Long compteur = 6 For lig = 12 To 43 Sheets("CS").Select If Cells(lig, 1) < 0 Then Range(Cells(lig, 4), Cells(lig, 5)).Select Selection.Copy Sheets("Feuil3").Select compteur = compteur + 1 Range("C" & compteur).Paste End If Next lig End Sub ~ [code.aspx?ID=39466 Mortalino] ~ Colorisation automatique @++

--Mortalino-- Le mystérieux chevalier, ~Provençal, le Gaulois~

psykocoic · Answer

grrr..

suis désolé de t'ennuyer comme ça, mais ça bug encore...

à cette ligne ci (juste avant end if) :

Range("C" & compteur).Paste

il me dit :
 
Erreur d'execution '438'
Propriété ou méthode non gérée par cet objet...

mortalino · Answer

Modifie Paste par PasteSpecial 

@++ 

<hr size="2" width="100%" />
  --Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~

psykocoic · Answer

ok. ça refonctionne de ce coté... mais...

ça n'a plus l'air de passer à la ligne suivante et donc de continuer...

psykocoic · Answer

dsl, j'ai rien dis... c'était une erreur de ma part.

je refait des tests

psykocoic · Answer

ok, super.

ça FONCTIONNE !

merci de ton aide... tu as résolu  en moins de deux un problème que je me pose depuis quelques temps...

si je peux faire quelque chose pour toi dans mon domaine, pas de soucis.

au fait, mes domaines :

- la santé (je suis infirmier)
- le secours (je suis pompier)
- la galère devant mon PC (je suis pas fortiche... mais plus que mes "vielles" collègues infirmières... lool)

mortalino · Answer

" le secours (je suis pompier)"
lol, j'ai été volontaire 4 ans, j'ai encore des reflexes 

Par contre, pour les "vielles" collègues infirmières, nop, mais s'il y a des jeunes, je suis preneur 

Bonne continuation  

@++ 

<hr size="2" width="100%" />
  --Mortalino--
Le mystérieux chevalier, ~Provençal, le Gaulois~

psykocoic · Answer

ok. je verrais... mais en ce moment, elles se marient quasi toutes...

me permets tu de te recontacter ( en cas de soucis) pour combiner l'écriture avec d'autres types d'alerte (y'en a que 3 en tout) pour que ça aille sur la meme page.

psykocoic · Answer

Bonjour à tous.

je continue sur la lancée...

j'ai voulu adapté le code que mortalino m'a aidé à construire pour deux autres tri.

pour rappel, voici le code :

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" &amp; compteur).PasteSpecial
    End If
Next lig


Sheets("suivi").Select


End Sub[code]

j'ai donc trois types d'alertes visueles grace à des mises en formes conditionnelles sur des résultats. comme vous voyez, ligne 10 du code, je souhaite extraire les lignes en alarmes (avec une valeur cellule < 0)

je pensais construire les 3 codes, sur trois macro différentes et donc 3 boutons de commande différents, de la meme manière que le premier, qui marche.

cependant, lorque je modifie cette ligne 10 de :

[code]If Cells(lig, 2) < 0 Then

If Cells(lig, 3) < 0 Then

ou If Cells(lig, 4) < 0 Then

afin de changer de colonne à vérifier, mes macros se mettent en erreur 2015 (il me semble oui..) et ne fonctionne donc pas...

Second souci, j'essaie de faire des copies de cellules (plusieurs) selon une selection faite par l'utilisateur.

en gros, une boite de dialogue, on tape un chiffre entre 1 et ... pour choisir une ligne.
action de la macro : on prend, sur cette ligne la cell de la collone C, celle de D, celle de G... ...

j'ai réussi à monter un code pour le cas de figure où on tape 1 puis, je l'ai adapté au cas où on tape 2... ... mais je ne voudrais pas non plus me taper une relecture de code avec copier coller pour X lignes possible à choisir.

y'a-t-il selon vous, un moyen de définir une variable dans ce code que je vais vous mettre ?

Sub Message2()
   Dim Retour As String
   
' je place l'utilisateur sur la page CS pour avoir la liste sous les yeux.


Sheets("CS").Select


' je fais apparaitre le formulaire de choix


   Retour = InputBox("Numéro attribué au SP :", "Veuillez rensigner le champs", "Entrez le numéro souhaité")


'si choix de la ligne n°1
   If Retour = "1" Then
' on copie groupement et CIS, ces cellules sont toujours les mêmes
   Sheets("fiche").Select
Range("E7").Value = Sheets("CS").Range("E3").Value
   Sheets("fiche").Select
Range("E8").Value = Sheets("CS").Range("E4").Value




' on copie le nom, prénom
   Sheets("fiche").Select
Range("C5").Value = Sheets("CS").Range("E12").Value
' on copie la date de naissance
    Sheets("fiche").Select
Range("F11").Value = Sheets("CS").Range("F12").Value
' on copie Dernier DTP
    Sheets("fiche").Select
Range("F13").Value = Sheets("CS").Range("X12").Value
' on copie Prochain DTP
    Sheets("fiche").Select
Range("F14").Value = Sheets("CS").Range("O12").Value
' on copie premier VHB
    Sheets("fiche").Select
Range("F16").Value = Sheets("CS").Range("Y12").Value
' on copie Second VHB
    Sheets("fiche").Select
Range("F17").Value = Sheets("CS").Range("Z12").Value
' on copie Troisième VHB
    Sheets("fiche").Select
Range("F18").Value = Sheets("CS").Range("AA12").Value
' on copie délai par défaut VMA
    Sheets("fiche").Select
Range("F23").Value = Sheets("CS").Range("P12").Value
' on copie délai corrigé VMA
    Sheets("fiche").Select
Range("F24").Value = Sheets("CS").Range("Q12").Value
' on copie date bio
    Sheets("fiche").Select
Range("F29").Value = Sheets("CS").Range("H12").Value
' on copie la sérologie
    Sheets("fiche").Select
Range("F20").Value = Sheets("CS").Range("M12").Value
' on copie la date de sérologie
    Sheets("fiche").Select
Range("F21").Value = Sheets("CS").Range("N12").Value
' on copie date derniere VMA
    Sheets("fiche").Select
Range("F26").Value = Sheets("CS").Range("W12").Value
' on copie date prochaine VMA
    Sheets("fiche").Select
Range("F27").Value = Sheets("CS").Range("T12").Value
' on copie date dernière biologie
    Sheets("fiche").Select
Range("F29").Value = Sheets("CS").Range("H12").Value
' on copie date dernier ECG
    Sheets("fiche").Select
Range("F30").Value = Sheets("CS").Range("I12").Value
' on copie date derniere Rx Pulm.
    Sheets("fiche").Select
Range("F31").Value = Sheets("CS").Range("J12").Value
' on copie date dernier visite cardio
    Sheets("fiche").Select
Range("F32").Value = Sheets("CS").Range("K12").Value
' on copie observation
    Sheets("fiche").Select
Range("E34").Value = Sheets("CS").Range("G12").Value
' on copie date dernier vaccin fievre jaune
    Sheets("fiche").Select
Range("F38").Value = Sheets("CS").Range("AD12").Value
' on copie date dernier vaccin rage
    Sheets("fiche").Select
Range("F37").Value = Sheets("CS").Range("AF12").Value
' on copie date dernier vaccin Hep A
    Sheets("fiche").Select
Range("F39").Value = Sheets("CS").Range("AE12").Value
' on copie date dernier vaccin Typhim
    Sheets("fiche").Select
Range("F36").Value = Sheets("CS").Range("AG12").Value
   End If




'si choix de la ligne n°2
   If Retour = "2" Then
' on copie groupement et CIS, ces cellules sont toujours les mêmes
   Sheets("fiche").Select
Range("E7").Value = Sheets("CS").Range("E3").Value
   Sheets("fiche").Select
Range("E8").Value = Sheets("CS").Range("E4").Value




' on copie le nom, prénom
   Sheets("fiche").Select
Range("C5").Value = Sheets("CS").Range("E13").Value
' on copie la date de naissance
    Sheets("fiche").Select
Range("F11").Value = Sheets("CS").Range("F13").Value
' on copie Dernier DTP
    Sheets("fiche").Select
Range("F13").Value = Sheets("CS").Range("X13").Value
' on copie Prochain DTP
    Sheets("fiche").Select
Range("F14").Value = Sheets("CS").Range("O13").Value
' on copie premier VHB
    Sheets("fiche").Select
Range("F16").Value = Sheets("CS").Range("Y13").Value
' on copie Second VHB
    Sheets("fiche").Select
Range("F17").Value = Sheets("CS").Range("Z13").Value
' on copie Troisième VHB
    Sheets("fiche").Select
Range("F18").Value = Sheets("CS").Range("AA13").Value
' on copie délai par défaut VMA
    Sheets("fiche").Select
Range("F23").Value = Sheets("CS").Range("P13").Value
' on copie délai corrigé VMA
    Sheets("fiche").Select
Range("F24").Value = Sheets("CS").Range("Q13").Value
' on copie date bio
    Sheets("fiche").Select
Range("F29").Value = Sheets("CS").Range("H13").Value
' on copie la sérologie
    Sheets("fiche").Select
Range("F20").Value = Sheets("CS").Range("M13").Value
' on copie la date de sérologie
    Sheets("fiche").Select
Range("F21").Value = Sheets("CS").Range("N13").Value
' on copie date derniere VMA
    Sheets("fiche").Select
Range("F26").Value = Sheets("CS").Range("W13").Value
' on copie date prochaine VMA
    Sheets("fiche").Select
Range("F27").Value = Sheets("CS").Range("T13").Value
' on copie date dernière biologie
    Sheets("fiche").Select
Range("F29").Value = Sheets("CS").Range("H13").Value
' on copie date dernier ECG
    Sheets("fiche").Select
Range("F30").Value = Sheets("CS").Range("I13").Value
' on copie date derniere Rx Pulm.
    Sheets("fiche").Select
Range("F31").Value = Sheets("CS").Range("J13").Value
' on copie date dernier visite cardio
    Sheets("fiche").Select
Range("F32").Value = Sheets("CS").Range("K13").Value
' on copie observation
    Sheets("fiche").Select
Range("E34").Value = Sheets("CS").Range("G13").Value
' on copie date dernier vaccin fievre jaune
    Sheets("fiche").Select
Range("F38").Value = Sheets("CS").Range("AD13").Value
' on copie date dernier vaccin rage
    Sheets("fiche").Select
Range("F37").Value = Sheets("CS").Range("AF13").Value
' on copie date dernier vaccin Hep A
    Sheets("fiche").Select
Range("F39").Value = Sheets("CS").Range("AE13").Value
' on copie date dernier vaccin Typhim
    Sheets("fiche").Select
Range("F36").Value = Sheets("CS").Range("AG13").Value
   End If
  
' ... ... ... 
  
End Sub

une ame charitable pour m'aider ?

cs_MPi · Answer

OK, fais ce test
Dans Feuil1, écrit (ou copie) ces données
L'important c'est la colonne 1 qui sert de base à la RechercheV

<col style= \"width: 60pt;\" span=\"3\" width=\"80\" />----
1, a, 123, ----
2, b, 234, ----
3, c, 345, ----
4, d, 456, ----
5, e, 567, ----
6, f, 678, ----
7, g, 789, ----
8, h, 900, ----
9, i, 1011, ----
10, j, 1122

Ensuite, dans Feuil2, inscrit 1 en A1

Dans une autre cellule de Feuil2, inscris cette Formule
=RECHERCHEV(A1;  Feuil1!A:C;   2 ;  FAUX)    puis ENTER

Puis dans une autre cellule, inscrit celle-ci
 =RECHERCHEV(A1;  Feuil1!A:C;  3;  FAUX)

Maintenant, toujours dans Feuil2, change le 1 en A1 pour un 2, puis un 3,... tu vas remarquer les valeurs qui changent là où sont les 2 formules.

Dans la RechercheV, il y a 4 paramètres
- la valeur recherchée    (celle inscrite en A1)
- la plage dans laquelle s'effectue la recherche    (ici les colonnes A à C de Feuil1)
- le nombre de colonnes vers la droite (la colonne de départ, ici A, étant = 1)
- FAUX indique qu'on recherche la valeur exacte

Donc, en partant de là, tu peux inscrire les formules un peu partout dans ta feuille de Fiche. Après ton InputBox, tu mets la valeur demandée en A1 (ou ailleurs) et tes formules s'ajusteront. L'important, c'est que tu définisses le Range nécessaire dans ton cas. Plutôt que de mettre A:C, tu peux y aller avec A:BH et tu ajustes le nombre de colonnes vers la droite selon la valeur que tu vois voir inscrite

En espérant que ça puisse t'aider...

MPi

Macro excel "tri de ligne et copie vers feuil3"

34 réponses

Votre réponse

Discussions similaires