Microsoft 365 Macro pour split de données sur onglet nommé

vgendron à dit:

Question: les colonnes vides C et D masquées.. c'est volontaire?

Cliquez pour agrandir...

job75 à dit:

Bonjour à tous,

Une autre solution, elle n'utilise pas de feuille MODELE :

VB:

Private Sub CommandButton1_Click()
Dim w As Worksheet, d As Object, P As Range, i&, nom$, j&
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---RAZ---
For Each w In Worksheets
    If w.Name <> Me.Name Then w.Delete
Next
'---création---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
Set P = Range("A5:K" & Range("B" & Rows.Count).End(xlUp).Row)
If P.Rows.Count < 3 Then Exit Sub
For i = 3 To P.Rows.Count
    nom = CStr(P(i, 2))
    If nom <> "" And Not d.exists(nom) Then
        d(nom) = ""
        If FilterMode Then ShowAllData 'si la feuille est filtrée
        Set w = Worksheets.Add(After:=Sheets(Sheets.Count))
        w.Name = nom 'nomme la feuille
        Cells.Copy w.Cells 'copie tout
        w.Rows("7:" & Rows.Count).Delete 'RAZ
        P.Offset(1).AutoFilter 2, nom 'filtre automatique
        P.Copy w.[A5]
    End If
Next
AutoFilterMode = False 'retire le filtre
'---classement des feuilles---
For i = 2 To Sheets.Count - 1
    For j = i + 1 To Sheets.Count
        If Sheets(j).Name < Sheets(i).Name Then Sheets(j).Move Before:=Sheets(i)
Next j, i
Me.Activate
End Sub

A+

Cliquez pour agrandir...

vgendron à dit:

dans cette version
le modèle n'a plus la colonne "Personne"
==> le code est donc modifié pour coller les éléments de la ligne hors formules
j'ai laissé les colonnes 1 et 2 affichées pour ne pas les oublier

Cliquez pour agrandir...

vgendron à dit:

plutot que de te faire une solution clé en main je te donnes les pistes pour le faire toi meme.. on interviendra ensuite pour corriger si besoin
1) les onglets rouge : tu peux les supprimer, ils me servaient juste de sauvegarde au cas où
==> d'ailleurs, si tu regardes le code, tu verras qu'ils ne sont jamais utilisés
2) pour supprimer les colonnes en rouge
si j'ai bien compris la feuille "Matrice-Saisie" est issue d'une importation (copier coller d'un autre fichier)
le mieux est donc de supprimer les colonnes DANS le modèle
et ajuster le code pour ne copier que les données des colonnes utiles
si tu regardes le code, tu verras aussi que j'ai déjà fait le travail pour copier d'abord la colonne "Jour", et ensuite les colonnes 1 2 ...
puis la colonne Depl

==> il suffit donc de dupliquer et adapter ces lignes

3) pour fusionner, centrer==> utilise l'enregistreur de macro:
* tu lances l'enregistrement
* tu fusionnes et centre la zone que tu souhaites
* tu arretes l'enregistrement
et tu vas voir le code qui a été généré==> il suffit de l'adapter au besoin et de la placer au bon endroit dans la macro (là où le nom de la personne est mise en F3

4) pour la police noir/blanc:
en cliquant sur la table, l'onglet création / mettre sous forme de table: tu peux choisir le style que tu souhaites
et si ca ne suffit pas, tu modifies dans le modèle==> ce sera recopié

Cliquez pour agrandir...

Arnaud Legay à dit:

- il y a un soucis dans les colonnes des feuilles créées

Cliquez pour agrandir...

Private Sub CommandButton1_Click()
Dim w As Worksheet, d As Object, P As Range, i&, nom$, j&
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---RAZ---
For Each w In Worksheets
    If w.Name <> Me.Name Then w.Delete
Next
'---création---
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
Set P = Range("A5:K" & Range("B" & Rows.Count).End(xlUp).Row)
If P.Rows.Count < 3 Then Exit Sub
Columns("C:D").Hidden = False 'affiche
For i = 3 To P.Rows.Count
    nom = CStr(P(i, 2))
    If nom <> "" And Not d.exists(nom) Then
        d(nom) = ""
        If FilterMode Then ShowAllData 'si la feuille est filtrée
        Set w = Worksheets.Add(After:=Sheets(Sheets.Count))
        w.Name = nom 'nomme la feuille
        Cells.Copy w.Cells 'copie tout
        w.Rows("7:" & Rows.Count).Delete 'RAZ
        P.Offset(1).AutoFilter 2, nom 'filtre automatique
        P.Copy w.[A5]
        w.Columns("B:D").Hidden = True 'masque
        w.Columns(1).ColumnWidth = 29 'pour le logo
    End If
Next
Columns("C:D").Hidden = True 'masque
AutoFilterMode = False 'retire le filtre
'---classement des feuilles---
For i = 2 To Sheets.Count - 1
    For j = i + 1 To Sheets.Count
        If Sheets(j).Name < Sheets(i).Name Then Sheets(j).Move Before:=Sheets(i)
Next j, i
Me.Activate
End Sub

Arnaud Legay à dit:

- j'aimerai que la MATRICE-SAISIE se vide à la fin de la macro,

Cliquez pour agrandir...