XL 2013 Copier coller VBA

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion SAMESS
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
S

SAMESS

XLDnaute Nouveau
Bonjour Forum,

Je recherche un code vba qui me permette d'extraire le planning de chaque prof dans une nouvelle feuille avec son nom (voir exemple)
Merci d'avance
 

Pièces jointes

Solution
job75
Bonjour Marcel32 et merci d'être intervenu.

Maintenant les choses sont plus claires, pour les doublons il y a la date mais aussi la fonction occupée.

Voyez ce fichier (3) et le complément de code :
VB: 
'---vérification des doublons---
Set d = CreateObject("Scripting.Dictionary")
Set P = F.[B2].CurrentRegion 'à adapter
For i = 2 To P.Rows.Count
    For j = 4 To 6
        x = LCase(P(i, j) & P(i, 7) & P(1, j))
        If d.exists(x) Then MsgBox "Doublon sur '" & P(i, j) & "' pour le N° " & d(x) & " et le N° " & P(i, 1) & " !", 48: Exit Sub
        d(x) = P(i, 1) 'mémorise le N°
Next j, i
Aucune feuille ne sera créée tant qu'il restera un doublon.

A+
Trier par date Trier par votes
Bonjour SAMESS, Marcel32, Bruno,

Au départ seule la feuille "Planning" est nécessaire.

Voyez le fichier joint et la macro du bouton :
VB: 
Sub Creation_Feuilles()
Dim F As Worksheet, i&, d As Object, P As Range, ncol%, j%, x$, k%, lig&
Set F = Sheets("Planning")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---suppression des feuilles---
F.Move Before:=Sheets(1)
For i = Sheets.Count To 2 Step -1
    Sheets(i).Delete
Next i
'---création et remplissage des feuilles---
Set d = CreateObject("Scripting.Dictionary")
Set P = F.[B2].CurrentRegion 'à adapter
ncol = P.Columns.Count
For i = 2 To P.Rows.Count
    For j = 4 To 6 'colonnes à adapter
        x = Application.Proper(Trim(P(i, j))) 'NOMPROPRE
        If x <> "" Then
            If Not d.exists(x) Then
                Sheets.Add After:=Sheets(1)
                Sheets(2).Name = x
                For k = Sheets.Count To 3 Step -1
                    If x > Sheets(k).Name Then Sheets(x).Move After:=Sheets(k): Exit For 'classement des feuilles
                Next k
                With Sheets(x)
                    For k = 1 To ncol
                        .Columns(k).ColumnWidth = P(1, k).ColumnWidth 'largeurs des colonnes
                    Next
                    P.Rows(1).Copy .Cells(1)
                End With
            End If
            d(x) = d(x) + 1
            lig = d(x) + 1
            With Sheets(x).Cells(lig, 1)
                P.Rows(i).Copy .Cells
                .Value = P(i, 1) 'remplace la formule par la valeur
                With .Resize(, ncol).Interior
                    If lig Mod 2 Then .ColorIndex = xlNone Else .Color = RGB(221, 235, 247) 'bleu clair
                End With
            End With
        End If
Next j, i
F.Activate
End Sub
A+
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
job75 à dit:
Bonjour SAMESS, Marcel32, Bruno,

Au départ seule la feuille "Planning" est nécessaire.

Voyez le fichier joint et la macro du bouton :
VB: 
Sub Creation_Feuilles()
Dim F As Worksheet, i&, d As Object, P As Range, ncol%, j%, x$, k%, lig&
Set F = Sheets("Planning")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'---suppression des feuilles---
F.Move Before:=Sheets(1)
For i = Sheets.Count To 2 Step -1
    Sheets(i).Delete
Next i
'---création et remplissage des feuilles---
Set d = CreateObject("Scripting.Dictionary")
Set P = F.[B2].CurrentRegion 'à adapter
ncol = P.Columns.Count
For i = 2 To P.Rows.Count
    For j = 4 To 6 'colonnes à adapter
        x = Application.Proper(Trim(P(i, j))) 'NOMPROPRE
        If x <> "" Then
            If Not d.exists(x) Then
                Sheets.Add After:=Sheets(1)
                Sheets(2).Name = x
                For k = Sheets.Count To 3 Step -1
                    If x > Sheets(k).Name Then Sheets(x).Move After:=Sheets(k): Exit For 'classement des feuilles
                Next k
                With Sheets(x)
                    For k = 1 To ncol
                        .Columns(k).ColumnWidth = P(1, k).ColumnWidth 'largeurs des colonnes
                    Next
                    P.Rows(1).Copy .Cells(1)
                End With
            End If
            d(x) = d(x) + 1
            lig = d(x) + 1
            P.Rows(i).Copy Sheets(x).Cells(lig, 1)
            With Sheets(x).Cells(lig, 1).Resize(, ncol).Interior
                If lig Mod 2 Then .ColorIndex = xlNone Else .Color = RGB(221, 235, 247) 'bleu clair
            End With
        End If
Next j, i
F.Activate
End Sub
A+
Cliquez pour agrandir...
Merci beaucoup 🙂
 
Vote positif 0 Vote négatif
Bonjour job75
Comment vas-tu?
tu peux ajouter une autre petite partie ?
si la colonne H de chaque prof contient des doublent,le fichier de la prof sera supprimé et un msg d’erreur qui contient"il faut modifié le planning de la prof "le nom de prof")
si possible!
 
Vote positif 0 Vote négatif
Bonjour SAMESS, le forum,

Sur le fichier que j'ai joint il y a des doublons de dates dans 5 feuilles sur 6.

Dites-nous comment il faudrait modifier la feuille "Planning".

En effet ça ne sert à rien de balancer des messages dans la nature si l'on ne dit pas ce qu'il faut faire.

A+
 
Vote positif 0 Vote négatif
job75 à dit:
Bonjour SAMESS, le forum,

Sur le fichier que j'ai joint il y a des doublons de dates dans 5 feuilles sur 6.

Dites-nous comment il faudrait modifier la feuille "Planning".

En effet ça ne sert à rien de balancer des messages dans la nature si l'on ne dit pas ce qu'il faut faire.

A+
Cliquez pour agrandir...
Bonjour job75,le forum,
il affiche seulement la feuille qui n'est pas contient des doublent et pour les autres au lieu d'affiché un msg erreur, il regroupes toutes les plannings des profs qui contient des doublent dans une seule feuille
si possible!
merci d'avance 🙂
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

anthoYS
  • Résolu(e)
XL 2019 copier des valeurs de la verticale à l'horizontale. Possible d'un coup ?
2
Réponses
20
Affichages
114
gosselien
gosselien
A
  • Question Question
Déplacer données en vba
Réponses
3
Affichages
470
akm
A
O
  • Résolu(e)
XL 2013 Formule qui permet d'extraire le mois une date au format en jour/mois/année
Réponses
4
Affichages
429
onyirimba
O
O
  • Résolu(e)
XL 2013 Formule ou une programmation VBA qui permette de répartir des numéros de factures par ligne
Réponses
3
Affichages
122
JHA
J
treza88
  • Question Question
XL 2021 Copier coller qui ajoute une référence absolu Toute seule
2
Réponses
24
Affichages
924
TooFatBoy
TooFatBoy
lcouaci
  • Résolu(e)
Microsoft 365 Recherche sur plusieurs Feuilles
2
Réponses
18
Affichages
494
lcouaci
lcouaci
richardlion
  • Question Question
Microsoft 365 formule spécifique Excel
2 3
Réponses
30
Affichages
782
djidji59430
djidji59430
D
  • Question Question
XL 2021 Problème de macro
Réponses
5
Affichages
73
Didierpasdoué
D
K
  • Question Question
XL 2016 Coup de main pour créer un fichier Excel qui gère le suivi des visites médicales du personnel.
Réponses
4
Affichages
359
dysorthographie
dysorthographie
DAVID-44-
  • Question Question
Microsoft 365 Effacer (et non supprimer) une ligne suivant texte.
Réponses
6
Affichages
299
DAVID-44-
DAVID-44-
S
  • Résolu(e)
Power Query Optimisation powerquery
2
Réponses
16
Affichages
664
SophieS
S
O
  • Résolu(e)
XL 2013 Formule qui permet d'extraire un élément d'une séquence de mots séparé par un "-"
Réponses
4
Affichages
300
onyirimba
O
chinel
  • Résolu(e)
XL 2016 copier/coller en VBA
Réponses
11
Affichages
457
chinel
chinel
O
  • Résolu(e)
XL 2013 Formule qui isole 1 donnée d'une cellule
Réponses
4
Affichages
161
onyirimba
O
S
  • Résolu(e)
XL 2016 Avis / Aide réécriture code
2 3
Réponses
38
Affichages
427
safranien
S
N
  • Question Question
Microsoft 365 Excel automatisé pour gestion du temps par projet
Réponses
11
Affichages
367
Dudu2
Dudu2
J
  • Question Question
XL 2019 Problème d'affichage sur cellule non-vide pour Excel
Réponses
6
Affichages
226
JFC256
J
F
  • Question Question
Microsoft 365 comparaison horaire
Réponses
5
Affichages
377
falex
F
ARaul
  • Question Question
XL 2019 Copier et coller automatiquement une nouvelle donnée par un bouton, ListView décallée à la sur la page (Multipage) et vibration du Userform
2
Réponses
16
Affichages
243
TooFatBoy
TooFatBoy
B
  • Question Question
XL 2013 Corriger mes codes
2
Réponses
25
Affichages
648
Valtrase
Valtrase
Retour