XL 2013 reprendre des cellules d'une feuille dans une autre

madmab

XLDnaute Nouveau
Bonjour,
j'ai une petite base en excel mais je n'arrive pas à reprendre des données spécifiques d'un tableau et les retranscrire dans une autre feuille. Pourriez-vous m'aider s'il vous plait.

J'ai rajouté un fichier excel avec des explications plus détaillées.

Image 1 = ma base . ou il y a m - a - s = matin après-midi-soir

image 2 le formulaire ou les données seront retranscrite.

Ce que j'aimerais faire, c'est sur l'image 2 que lorsque l'on clique dans la liste déroulante sur l'exemple = Mr. Boeglin le formulaire ce remplisse avec les données récoltées sur la ligne de l'image 1.

Etant donné qu'il y a plusieurs facteurs sur les colonnes à respecter , je ne sais pas comment procéder pour les reprendre, il y a la date et matin près-midi et soir a respecter.

tab_plan_patient_03.jpg


tab_plan_patient_02.jpg


J'espère avoir était assez clair dans ma demande

D'avance un grand merci pour votre aide.
Madmab
 

Pièces jointes

  • Test.xlsx
    44.8 KB · Affichages: 3
Dernière édition:

job75

XLDnaute Barbatruc
0,10 seconde pour le recalcul des 372 formules de la feuille 'planC' c'est encore trop.

Car cela se produit chaque fois qu'on modifie une cellule, n'importe où, et c'est agaçant.

Dans ce fichier (3) j'ai donc supprimé l'instruction Application.volatile qui en était la cause.

Et pour que les formules soient recalculées quand on active la feuille j'ai ajouté cette macro :
VB:
Private Sub Worksheet_Activate()
[A1] = [A1] 'entraîne le recalcul de toutes les formules
End Sub
 

Pièces jointes

  • General(3).xlsm
    115.8 KB · Affichages: 3

job75

XLDnaute Barbatruc
Bonjour madmab, le forum,

Puisqu'on utilise une Worksheet_Activate autant tout faire dans cette macro, fichier (4) :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Worksheet_Activate 'lance la macro
End Sub

Private Sub Worksheet_Activate()
Dim F As Worksheet, h%, ncol%, nlig&, tablo, nom$, i&, j%, k%, dat As Variant, P As Range, n%, c As Range
Set F = Sheets("planG")
h = 12
ncol = 14
With [A1] '1ère cellule du tableau
    nlig = Cells(Rows.Count, .Column).End(xlUp).Row - .Row + 1 'sur la dernière ligne
    nlig = Application.Ceiling(nlig, h + 2) 'ajustement
    tablo = .Resize(nlig, ncol).Formula 'matrice, plus rapide
    nom = tablo(1, 1)
    nom = Application.VLookup(nom, Sheets("COLLEGUES").Columns("A:B"), 2, 0) 'initiale
    For i = 2 To UBound(tablo) Step h + 2 'lignes des dates
        For j = 1 To ncol Step 2
            For k = 1 To h
                tablo(i + k, j) = "" 'RAZ
                tablo(i + k, j + 1) = "" 'RAZ
            Next k
            dat = Evaluate(tablo(i, j)) 'évalue la formule
            If IsDate(dat) Then dat = CLng(CDate(dat))
            If IsNumeric(dat) Then
                Set P = F.Columns(Application.Match(dat, F.Rows(5), 0)).Resize(, 3)
                n = Application.CountIf(P, nom) 'NB.SI
                Set c = P.Cells(1)
                For k = 1 To IIf(n > h, h, n)
                    Set c = P.Find(nom, c, xlValues, xlWhole)
                    tablo(i + k, j) = F.Cells(c.Row, 1)
                    tablo(i + k, j + 1) = F.Cells(6, c.Column)
                Next k
            End If
    Next j, i
    '---restitution---
    Application.EnableEvents = False 'désactive les évènements
    .Resize(nlig, ncol) = tablo
    Application.EnableEvents = True 'réactive les évènements
End With
End Sub
C'est plus rapide qu'avec la fonction VBA.

A+
 

Pièces jointes

  • General(4).xlsm
    110.4 KB · Affichages: 2

Discussions similaires

Statistiques des forums

Discussions
312 079
Messages
2 085 133
Membres
102 790
dernier inscrit
nabilziad