Planning comparaison

Bonjour à tous

J'aurai besoin d'aide faire du VBA

voir Fichier ci joint.

Sur la Feuil1 c'est un planning que j'ai crée

voila je voudrais récuperer les donnée pour ma feuil 2

exemple :

Feuil1 Colonne B l'atelier Colonne C Matin (M) Apres midi (AP) et Nuit( N) colonne D ..... sont les jours

dans feuil 2

Dans la colonne A les nom qu'on retrouve dans les colonne D ... feuil1en fonction comment il travaille

dates les colonne B .. on retrouve les jours

et je voudrais mettre en automatique atelier et les M ou AP ou N en fonction comment il travaille

que le tableau se remplisse tout seul

cordialement

Bonjour Olivcoco,

As-tu toujours besoin d'aide?

Bonjour

Oui

si vous pouvez m'aider

Cordialement

Bonjour Olivcoco,

Une proposition de code :

Option Explicit
Sub scanPlanning()
    Const cColAtelier = 2
    Const cColEquipe = 3

    Dim oSheetPlanning As Worksheet, oSheetTo As Worksheet
    Dim oRangePlanning As Range
    Dim oRangeDates As Range
    Dim oCell As Range, oRange As Range

    Dim aNoms() As String
    Dim sNoms As String
    Dim i As Integer
    Dim lFirstRow As Long, lFirstCol As Long, lLastRow As Long, lLastCol As Long
    Dim lRow As Long, lcol As Long

    Set oSheetPlanning = ThisWorkbook.Worksheets(1)
    Set oSheetTo = ThisWorkbook.Worksheets(2)

    oSheetTo.Activate
    'On efface le contenu de la feuille de destination
    oSheetTo.Cells.Clear

    'On recopie la lignes de dates et des jours
    Set oRangeDates = ThisWorkbook.Names("LigneDates").RefersToRange
    oRangeDates.Copy oSheetTo.Cells(1, 2)
    Set oRange = oSheetTo.Range(oSheetTo.Cells(1, 2), oSheetTo.Cells(1, oSheetTo.UsedRange.Columns.Count))
    oRange.NumberFormat = "m/d/yyyy"
    Set oRangeDates = oRangeDates.Offset(1)
    oRangeDates.Copy oSheetTo.Cells(2, 2)
    oSheetTo.Cells.Font.Size = 11

    'On récupère la première cellule du planning
    Set oCell = ThisWorkbook.Names("DebutPlanning").RefersToRange
    lFirstRow = oCell.Row
    lFirstCol = oCell.Column
    lLastRow = oSheetPlanning.UsedRange.Rows.Count
    lLastCol = oSheetPlanning.UsedRange.Columns.Count

    'On parcourt la totalité des cellules du planning pour constituer la liste des noms
    For Each oCell In oSheetPlanning.Range(oSheetPlanning.Cells(lFirstRow, lFirstCol), oSheetPlanning.Cells(lLastRow, lLastCol)).Cells
        If Len(Trim(oCell.Value)) > 0 Then
            If InStr(1, sNoms, oCell.Value) = 0 Then
                sNoms = sNoms & oCell.Value & ";"
            End If
        End If
    Next
    aNoms = Split(Left(sNoms, Len(sNoms) - 1), ";")

    lRow = 0
    'Pour chaque nom de la liste constituée, on re-parcourt le planning et on renseigne la feuille de destination
    For i = 0 To UBound(aNoms)
        lRow = lRow + 3
        oSheetTo.Cells(lRow, 1).Value = aNoms(i)
        For Each oCell In oSheetPlanning.Range(oSheetPlanning.Cells(lFirstRow, lFirstCol), oSheetPlanning.Cells(lLastRow, lLastCol)).Cells
            If Trim(oCell.Value) = aNoms(i) Then
                oSheetTo.Cells(lRow, oCell.Column - 2).Value = oSheetPlanning.Cells(oCell.Row, cColAtelier).Value
                oSheetTo.Cells(lRow + 1, oCell.Column - 2).Value = oSheetPlanning.Cells(oCell.Row, cColEquipe).Value
            End If
        Next
    Next
End Sub