Microsoft 365 Ajout de ligne dans planning

[papoumarc]

Bonsoir,
J'ai un fichier avec 7 équipes (Service, Bureau, Poste A à E et étudiant) dont les noms sont visible dans la feuille paramètres.
Je souhaiterais lors de l'ajout d'un nom qui est repris en rouge, que ce prénom soit incorporer dans les feuilles janvier et février.
Pour Alphonse que ce prénom soit mis à la suite de Frédéric et bien sur en vert.
Et la même chose pour chaque ajout d'un prénom dans une des colonnes de n'importe quel équipe.

Déjà merci pour ceux qui me proposeront de l'aide.
Critère à prendre en contre, je ne connais rien en VBA mais ne suis pas contre le fait de devoir l'utiliser.

 

[papoumarc]

Bonjour,
Personne pour une petite aide ?

 

[job75]

Bonjour papoumarc,

Voyez le fichier joint et cette macro :

Sub MAJ() 'bouton MAJ des feuilles
Dim tablo, nlig&, j%, coul&, i&, x$, w As Worksheet, ligmax&, lig&
With Sheets("Paramètres").[A3].CurrentRegion
    tablo = .Resize(, 7)
    nlig = UBound(tablo)
    For j = 1 To 7
        coul = .Cells(1, j).Interior.Color
        For i = 2 To nlig
            x = tablo(i, j)
            If x <> "" Then
                For Each w In Worksheets
                    If IsDate("1/" & w.Name) Then
                        If Application.CountIf(w.Columns(1), x) = 0 Then
                            If w.FilterMode Then w.ShowAllData 'si la feuille est filtrée
                            ligmax = 0
                            For lig = 7 To w.Cells(w.Rows.Count, 1).End(xlUp).Row
                                If w.Cells(lig, 1).Interior.Color = coul Then ligmax = lig
                            Next lig
                            If ligmax Then
                                w.Rows(ligmax + 1).Insert
                                w.Cells(ligmax + 1, 1) = x
                                With w.Rows(ligmax + 1).Resize(, 33)
                                    .Borders(xlEdgeTop).Weight = xlThin 'bordure fine
                                    .Borders(xlEdgeBottom).Weight = xlMedium 'bordure moyenne
                                End With
                            End If
                        End If
                    End If
                Next w
            End If
    Next i, j
End With
End Sub

A+

 

[papoumarc]

C'est exactement ce que je voulais, Merci Job75.
Est-il possible d'avoir l'inverse aussi si je supprime un prénom dans paramètres qu'il supprime la ligne du tableau ?

 

[job75]

si je supprime un prénom dans paramètres qu'il supprime la ligne du tableau ?

Fichier (2) avec la macro complétée :

Sub MAJ() 'bouton MAJ des feuilles
Dim tablo, nlig&, j%, coul&, colonne As Range, w As Worksheet, lig&, x$, i&, ligmax&
With Sheets("Paramètres").[A3].CurrentRegion
    tablo = .Resize(, 7)
    nlig = UBound(tablo)
    For j = 1 To 7
        coul = .Cells(1, j).Interior.Color
        '---supprime les lignes---
        Set colonne = .Columns(j)
        For Each w In Worksheets
            If IsDate("1/" & w.Name) Then
                If w.FilterMode Then w.ShowAllData 'si la feuille est filtrée
                For lig = w.Cells(w.Rows.Count, 1).End(xlUp).Row To 7 Step -1
                    x = w.Cells(lig, 1)
                    If w.Cells(lig, 1).Interior.Color = coul Then If Application.CountIf(colonne, x) = 0 Then _
                        If MsgBox("Supprimer '" & x & "' en " & w.Name & "!A" & lig & " ?", 4) = 6 Then w.Rows(lig).Delete
                Next lig
            End If
        Next w
        '---ajoute les lignes---
        For i = 2 To nlig
            x = tablo(i, j)
            If x <> "" Then
                For Each w In Worksheets
                    If IsDate("1/" & w.Name) Then
                        If Application.CountIf(w.Columns(1), x) = 0 Then
                            ligmax = 0
                            For lig = 7 To w.Cells(w.Rows.Count, 1).End(xlUp).Row
                                If w.Cells(lig, 1).Interior.Color = coul Then ligmax = lig
                            Next lig
                            If ligmax Then
                                w.Rows(ligmax + 1).Insert
                                w.Cells(ligmax + 1, 1).Resize(, 2).Merge 'cellules fusionnées
                                w.Cells(ligmax + 1, 1) = x
                                With w.Rows(ligmax + 1).Resize(, w.Cells(6, w.Columns.Count).End(xlToLeft).Column)
                                    .Borders.Weight = xlThin 'bordure fine
                                    .Borders(xlEdgeTop).Weight = xlThin 'bordure fine
                                    .Borders(xlEdgeBottom).Weight = xlMedium 'bordure moyenne
                                End With
                            End If
                        End If
                    End If
                Next w
            End If
    Next i, j
End With
End Sub

Pour les lignes ajoutées j'ai revu la question des bordures.

 

[papoumarc]

Merci, c'est tout ce dont j'avais besoin