Macro Vba Extraction de données en fonction de la date sous Exce

Vdkvodka Messages postés 1 Date d'inscription Statut Membre Dernière intervention -
nanas - 15 déc. 2014 à 16:59

Bonjour,
Je suis novice en Vba et j'ai besoin de faire une macro me permettant d'extraire les données d'une feuille de calcul sur une autre feuille de calcul du même classeur en fonction de la date du jour qui est indiqué sur le feuille de destination.

Les deux tableaux ont la même structure je voudrais donc obtenir l'ensemble des lignes ayant pour date la date du jour dans la feuille de calcul de destination.

Quelqu'un aurait il l'amabilité de me proposer une macro qui me permettrait d'effectuer ce travail?

N'hésitez pas à revenir avec vos réponses et vos questions si je ne suis pas assez précis. Je prendrait toutes aides qu'on pourra m'apporter.

Cordialement

Afficher la suite

A voir également:

Vba extraire des données d'un tableau excel vers un autre tableau
Exce ✓ - Forum Bureautique
Proteger une image ou + dans un classeur exce - Forum Bureautique
Insérer une image en en-tête de document Exce - Forum Logiciels
Changer la "couleur automatique" de Exce - Forum Bureautique
Le publipostage word ne prend qu'une ligne sur 2 du tableau Exce ✓ - Forum Excel

5 réponses

Réponse 1 / 5

nanas

BONJOUR michel_m

merci d'avoir répondu aussi vite :)
et bien j'ai une feuille 1 qui s'incrémente automatiquement via un userform et qui me remplie un tableau de prise de rendez vous via cette feuille1 j'aimerais récupérer les lignes correspondant à une date précise sur une feuille2 ou l'on inscrit la date que l'on veut dans une cellule en feuille2 VOICI LE LIEN QUI TE PERMETTRA DE RECUPERER MON fichier

http://cjoint.com/?0Llj7j4HaCs

merci pour ton aide

Réponse 2 / 5

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

Excuse moi je n'avais pas vu qu'il y avait des colonnes masquées

Option Explicit
'-----
Sub Transfert_PROG()
Dim dd As Date, Lig As Byte, Nbre As Byte, Transfert

Application.ScreenUpdating = False

dd = Sheets("PROGRAMME BLOC OP").Range("O1")
With Sheets("feuille HOPIT-AMBU")
    Nbre = Application.CountIf(.Columns("N"), dd)
    If Nbre = 0 Then: GoTo vide
    Lig = .Columns("N").Find(dd, Range("N1")).Row
    Transfert = .Range(.Cells(Lig, "N"), .Cells(Lig + Nbre - 1, "W"))
End With

With Sheets("PROGRAMME BLOC OP")
    .Range("O2:X50").ClearContents
    .Range("O2").Resize(Nbre, 10) = Transfert
    .Activate
End With
Exit Sub
vide:
MsgBox "la date " & dd & " est inconnue dans la liste", vbCritical
End Sub

nanas

MERCIIIIIIIIIIIII michel_m

Ça marche super bien par contre j'ai des petits bug lorsque j'inscris une date dans la feuille prog op range O1 et que je valide avec mon bonton recherche, des fois pas tout le temps, j'ai une date qui n'a rien avoir qui s'ajoute je comprend pas du tout pourquoi??? La colonne commentaire ne s'ajoute pas non plus ???

de plus sur ma feuille hopit_ambu le tri automatique que j'ai programmé en fonction de la date d'intervention et du service, marche très bien mais lorsque j'essaye de faire la même chose pour ma feuille prog-op (classement en fonction des praticiens) cela ne marche pas et je ne comprend vraiment pas pourquoi???

dsl de t'embêter encore :/

merciiiii encore !!!!

http://cjoint.com/?3LmoeZ2EcF4

nanas

bonjour michel_m

après plusieurs essaye je me suis rendu compte que le nombre maximum de date pouvant être trouvé par la fonction "find" est de 3, j'ai réussi à lui faire éviter de me chercher des date non inscrit dans la cellule "O1" mais j'ai n'est toujours pas compris pourquoi il ne peut rechercher plus de 3 dates identique ??

je te renvoi le fichier que j'ai travaillé, si tu a encore du temps à m'accorder

merci encore pour ton aide :)

http://cjoint.com/?0Lpox6TG79M

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314 > nanas

Bonjjour

Tout simplement parce que tes 3 dernières dates sont du texte et non une date

nanas

merci mille fois dsl mais des fois j'ai trop du mal merci beaucoup heureusement qu'il existe des gens comme toi pour les filles comme moi

Réponse 3 / 5

via55 Messages postés 14512 Date d'inscription Statut Membre Dernière intervention 2 746

Bonjour

Cela correspond il à tes attentes ?
A adapter à ton fichier

Sub copier()
dd = Sheets("Feuil2").Range("A1") ' recupere la date recherchée qui  est en A1 de la feuille 2
Sheets("Feuil1").Select
Range("B2").Select  'se positionne sur la 1ere cellule du tableau feuille 1
der = ActiveCell.End(xlDown).Row ' determine dernier ligne du tableau1
x = 1 N° de ligne où doit commencer le tableau 2
For n = 2 To der 'boucle sur les les lignes du tableau 1
' lorsque la date du tableau 1 correspond à celle recherchée on copie la ligne et on la colle en feuille 2 sur ligne x
If Sheets("Feuil1").Cells(n, 2).Value = dd Then 
 Sheets("Feuil1").Rows(n).Copy Sheets("Feuil2").Rows(x)
x = x + 1 ' et on incremente x
End if
Next
Sheets("Feuil2").Select
End Sub

Cdlmnt

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

Bonjour

la variable x ne s'incrémente pas car dans le IF !!! on tourne donc à vide jusqu'à la dernière ligne
Pas de gestion de l'erreur (la date en feuille 2 n'est pas dans la liste...)
Toujours déclarer les variables

Proposition sans les select -selection à éviter au maximum

Option Explicit 
Sub copier() 
Dim dd As Date, Lig As Integer, xx As Date 

Application.ScreenUpdating = False 

dd = Sheets("Feuil2").Range("A1") 
With Sheets("Feuil1") 
     Lig = 1 
     Do 
          Lig = Lig + 1 
          xx = .Cells(Lig, "B") 
          If Lig > .Columns("B").Find("*", , , , , xlPrevious).Row Then GoTo vide 
     Loop Until xx = dd 
Sheets("feuil2").Rows(Lig) = .Rows(Lig).Value 
End With 

Sheets("Feuil2").Select 
Exit Sub 
vide: 
MsgBox "la date " & dd & " est inconnue dans la liste", vbCritical 
End Sub

nanas > michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention

bonjour à toi michel_m j'ai repris ta portion de codage et je l'ai adapté à mon projet sachant que j'ai exactement la même requête que vdk vodka cependant le code marche mais seulement pour une seule date sur une ligne, les autres lignes à la même date n'apparaissent pas??

pourrai tu m'apporter ton aide car je ne trouve vraiment pas ou ce trouve le problème
voici la portion de code adapté à mon projet

Option Explicit
Sub Transfert_PROG()
Dim dd As Date, Lig As Integer, xx As Date

Application.ScreenUpdating = False

dd = Sheets("PROGRAMME BLOC OP").Range("O1")
With Sheets("feuille HOPIT-AMBU")
     Lig = 1
     Do
          Lig = Lig + 1
          xx = .Cells(Lig, "N")
          If Lig > .Columns("N").Find("*", , , , , xlPrevious).Row Then GoTo vide
     Loop Until xx = dd
Sheets("PROGRAMME BLOC OP").Rows(Lig) = .Rows(Lig).Value
End With

Sheets("PROGRAMME BLOC OP").Select
Exit Sub
vide:
MsgBox "la date " & dd & " est inconnue dans la liste", vbCritical
End Sub

via55 Messages postés 14512 Date d'inscription Statut Membre Dernière intervention 2 746

Bonjour Michel

Exact ta solution est bien meilleure
J'en prend bonne note

Cdlmnt

Réponse 4 / 5

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314

Bien reçu, merci
joli travail :o)

beaucoup de trucs à faire , donc, sois patiente

petits renseignements:
dans la feuille "hopit-amb" les dates d'intervention sont elles triées dans l'ordre croissant---> tous les 12/10/14 ensemble ?

pourrais tu me mettre le nom des champs dans programme bloc op
nassim? Zaher?, 201B?.... je n'ai pas trouvé d'où ca vient

Michel

nanas

rebonjour michel_m

dsl c'est le nom d'un vrai patient et je l'ai remplacé dans la feuille hopit-ambu
sinon dans la feuille hopit-ambu les dates sont triées en fonction de la date d'intervention et du service.
j'ai du modifié mon userform de départ qui permettais de le faire automatiquement car une des responsable de service me l'a demandé (on ne pouvais pas attribuer la chambre donc le service dès la prise de rdv cela doit ce faire par la suite la veille de l'admission).

dsl mais je ne l'ai pas changé dans le code cela est toujours apparent par contre je vais créer un nouveau bouton dans la feuille hopit-ambu qui permettra de le faire après saisie du service et de la chambre sur la liste déroulante

nb: il y a trois service différent qui vont ce servir de ce fichier donc je vais cloisonner par code chaque feuille en fonction des ayant droit mais je sais pas si en faisant ça les info saisie pourront s'incrémenté quand même??

MERCI ENCORE :))))

nouveau fichier

http://cjoint.com/?DLlnWWNo7VZ

nanas

un rdv prie en ambulatoire la date d'arrivée et la date d'opération est la même le patient entre le matin et sort dans l'après-midi (petite intervention) l'hospitalisation quand à elle nécessite une surveillance pré et post opératoire donc la date d'entrée peut différer de la date d'intervention le patient peut rentrer la veille et ce faire opérer le lendemain ou une semaine après cela dépend de l'intervention d'où la nécessité de planifier les intervention par service pour les service concernés et de planifier un programme bloc opératoire par jour nul besoin de savoir si c'est de l'hospit ou de l'ambu .

voilà j'espère avoir clarifié ma demande :))

michel_m Messages postés 16602 Date d'inscription Statut Contributeur Dernière intervention 3 314 > nanas

Apparemment, c'était le mème classeur avec nasser ....

On ne peut pas recopier la ligne car l'ordre des champs est différent entre les 2 feuilles- par ex; l'age a disparu dans bloc op

Rappel:
pourrais tu me mettre le nom des champs dans programme bloc op

nanas

J'ai juste mis en masqué les colonnes inutile pour un programme bloc opératoire

dsl j'ai envoyé le mauvais fichier :$

http://cjoint.com/?DLlqESh1bHh

Discussions similaires

Excel Macro Extraction Données

Problème enregistrement macro excel

ouverture d'un fichier excel à partir d'un code VBA

Effacer macro excel 2013

macro dans classeur macro personnelles

Comment supprimer certaines macro perso

Votre réponse

Discussions similaires