Modification VBA

Bonjour,

j'ai un tableau dynamique qui me permet de visualiser toutes les absences de différents services.

Tout fonctionne bien mais j'aimerai rajouter la colonne observation dans le tableau qui se trouve dans la feuille Absence j'ai essayé de modifier la formule mais en vain

En PJ le tableau

Merci par avance pour votre aide

Cordialement

Bonjour Mango19

Voici le code modifié, tout est pourtant bien indiqué

Private Sub Worksheet_Activate()
  Dim tbU, newtbU()                             'définit les tableaux de valeurs
  Dim i%, k%, lig%, x%
  Dim wsh, sh As Worksheet
  Dim lo As ListObject
  Dim colNomPrenom As Integer, colGrade As Integer, colAbsence As Integer, colDebutAbsence As Integer, _
      colFinAbsence As Integer, colRemplacePar As Integer, ColObservation As Integer

  Application.ScreenUpdating = False

  wsh = Array("Anesthésie SSPI", "Laboratoire", "Pharmacie", "SRPR", "Réanimation USIP", "SAMU", "SMUR", "Stérilisation", "Urgences", "DO", "CESU") 'tu peux rajouter des feuilles ici(tableau contenant le nom des feuilles à traiter)
  Set lo = Sheets("Absences").ListObjects("tb_absences") 'définit le tableau structuré de la feuille Absences (nommé tb_absences)

  With lo
      If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete 'efface les données de la feuille Absences
  End With

  For x = LBound(wsh) To UBound(wsh)            'boucle sur chaque nom du  tableau wsh
    For Each sh In ThisWorkbook.Worksheets    'boucle sur chaue feuille du classeur
      If sh.Name Like wsh(x) Then           'si le nom de la feuille du classeur fait partie du tableau wsh
        tbU = sh.Range("A4:T" & sh.Range("E" & Rows.Count).End(xlUp).Row) 'on définit le tableau de données
        k = 0                             '............................................index de départ

        colNomPrenom = getCol("Nom & Prénom", sh, 2)
        colGrade = getCol("Grade", sh, 2)
        colAbsence = getCol("Absence", sh, 2)
        colDebutAbsence = getCol("Début D'absence", sh, 2)
        colFinAbsence = getCol("Fin d'Absence", sh, 2)
        colRemplacePar = getCol("Remplacé par", sh, 2)
        ColObservation = getCol("Observations", sh, 2)

        ReDim newtbU(0 To UBound(tbU, 1), 1 To 8) '........on crée un tableau temporaire
        For i = 1 To UBound(tbU, 1)       '.....................on boucle sur les lignes du tableau de données
            If tbU(i, 5) <> "" And tbU(i, 12) <> "" Then '....si Nom/prénom et Absences remplis
                newtbU(k, 1) = tbU(i, colNomPrenom) 'nom prénom
                newtbU(k, 2) = sh.Name    'service
                newtbU(k, 3) = tbU(i, colGrade) 'grade
                newtbU(k, 4) = tbU(i, colAbsence) 'absence
                newtbU(k, 5) = tbU(i, colDebutAbsence) 'début absence
                newtbU(k, 6) = tbU(i, colFinAbsence) 'fin absence
                newtbU(k, 7) = tbU(i, colRemplacePar) 'remplacé par
                newtbU(k, 8) = tbU(i, ColObservation) ' Observations
                k = k + 1                 '................incrémente l'index
            End If
        Next i                            '......................prochaine ligne du tableau de valeur
        If k > 0 Then                     '..............si tableau temporaire comporte au moins 1 ligne
            On Error Resume Next
            With lo
                .ListRows.Add             '............rajoute une ligne au tableau de la feuille Absences
                lig = .ListColumns(1).Range.Find("", SearchDirection:=xlNext).Row '...définit la première ligne vide
                Sheets("Absences").Range("A" & lig).Resize(k, 8).Value = newtbU '.....écrit les données du tableau temporaire
            End With
        End If
        End If
    Next sh                                   '...................................................................prochaine feuille du classeur
  Next x                                        '.....................................................................prochaine valeur du tableau wsh

  Erase tbU: Erase newtbU: Set wsh = Nothing    '..................................efface tous les tableaux (libère la mémoire)
End Sub

Function getCol(nomCol As String, Wks As Worksheet, ligEnTete As Integer) As Integer
    Dim colFin As Integer, numCol As Integer

    With Wks
        colFin = .Cells(ligEnTete, .Columns.Count).End(xlToLeft).Column

        For j = 1 To colFin
            If LCase(.Cells(ligEnTete, j)) = LCase(nomCol) Then
                numCol = j
                GoTo fin
            End If
        Next j
    End With

fin:
    getCol = numCol
End Function

A+

Bonjour

Ci joint ma solution

A+ François

Un immense merci

Bien cordialement