XL 2019 copier cellule dans une autre feuille en colonne

chinel · 21 Décembre 2022

Bonjour tout monde, mon projet avance bien et j'en suis content, merci aux gens de ce forum . J'ai besoin d'aide car j'ai ma feuille "Planning" et je désire copier les prénoms des gens dans les colonnes respectives (leur lui de travail) (emplacement) dans la feuille "Personnel". Mon but c'est de pouvoir faire des statiques du style "qui va ou et combien de fois sur l'année?" Merci d'avance !

Phil69970 · 21 Décembre 2022

Bonjour @chinel

Je te propose ce fichier
J'ai renommé ces 4 cellules de CE en CE1 à CE4 pour que cela fonctionne

Merci de ton retour

@Phil69970

chinel · 22 Décembre 2022

Phil69970 à dit:
Bonjour @chinel

Je te propose ce fichier
J'ai renommé ces 4 cellules de CE en CE1 à CE4 pour que cela fonctionne

Regarde la pièce jointe 1158438

Merci de ton retour

@Phil69970

Un grand merci ! Bonne journée !

job75 · 22 Décembre 2022

Bonjour chinel, Phil69970, le forum,

Comme il y a très peu d'explications il paraît inutile de se casser la tête.

Voyez cette macro dans le code de la feuille "Personnel" :

VB:

Private Sub Worksheet_Activate()
Dim c As Range, n%
For Each c In Sheets("Planning").[A8,A10:A15,F8,F10:F15,A17,A19:A22,F17,F19:F23,A25:A29] 'plage adaptable
    n = n + 1
    Cells(1, n) = UCase(c)
    Cells(2, n) = c(1, 2)
Next
[A1].Resize(2, n).Borders.Weight = xlMedium 'bordures
[A1].Offset(, n).Resize(2, Columns.Count - n).Delete xlToLeft 'RAZ à droite
Columns.AutoFit 'ajustement largeurs
End Sub

Elle se déclenche quand on active la feuille.

Nota 1 : a priori le bouton IMPRIMER n'a rien à voir avec ces copies de cellules.

Nota 2 : j'ai allégé la feuille "Jours fériés" qui pesait anormalement lourd.

A+

chinel · 22 Décembre 2022

job75 à dit:
Bonjour chinel, Phil69970, le forum,

Comme il y a très peu d'explications il paraît inutile de se casser la tête.

Voyez cette macro dans le code de la feuille "Personnel" :

VB:

Private Sub Worksheet_Activate() Dim c As Range, n% For Each c In Sheets("Planning").[A8,A10:A15,F8,F10:F15,A17,A19:A22,F17,F19:F23,A25:A29] 'plage adaptable n = n + 1 Cells(1, n) = UCase(c) Cells(2, n) = c(1, 2) Next [A1].Resize(2, n).Borders.Weight = xlMedium 'bordures [A1].Offset(, n).Resize(2, Columns.Count - n).Delete xlToLeft 'RAZ à droite Columns.AutoFit 'ajustement largeurs End Sub

Elle se déclenche quand on active la feuille.

Nota 1 : a priori le bouton IMPRIMER n'a rien à voir avec ces copies de cellules.

Nota 2 : j'ai allégé la feuille "Jours fériés" qui pesait anormalement lourd.

A+

Merci

job75

mais ce n'est pas vraiment ça que je désire mais merci quand même ! je préfère l'autre solution

job75

chinel · 22 Décembre 2022

Dans le fichier de

Phil69970

comment peut-on faire pour mettre en place des statistiques ? statistique du genre: quel personne à quel machine et combien de fois cette personne va sur cette machine. dois-je faire une "recherchev" ?

job75 · 22 Décembre 2022

chinel à dit:
je désire copier les prénoms des gens dans les colonnes respectives (leur lui de travail) (emplacement) dans la feuille "Personnel".

C'est bien ce que fait ma macro, si vous voulez autre chose dites-le.

Edit : nos posts se sont croisés.

chinel · 22 Décembre 2022

job75 à dit:
C'est bien ce que fait ma macro, si vous voulez autre chose dites-le.

oui j'apprécie votre boulot mais je préfère la macro de

Phil69970

qui peut mettre les prénoms à la suite de la'autre. Mais maintenant, je voudrais mettre en place un système qui me permettrai de voir combien de fois l'opérateur va sur une machine. Exemple: Didier sur T10 (10 fois) vis-à-vis du planning réalisé tous les jours.

job75 · 22 Décembre 2022

Je comprends que vous voulez archiver les affectations alors voyez ce fichier (2) et la macro du bouton :

VB:

Sub Archivage()
If MsgBox("Avez-vous bien vérifié les affectations ?", vbYesNo + vbQuestion, "Archivage") = vbNo Then Exit Sub
Dim F As Worksheet, lig&, c As Range, n%
Set F = Sheets("Personnel")
lig = F.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
For Each c In Sheets("Planning").[B8,B10:B15,G8,G10:G15,B17,B19:B22,G17,G19:G23,B25:B29] 'plage adaptable
    n = n + 1
    F.Cells(lig, n) = c
Next
F.Cells(lig, 1).Resize(, n).Borders.Weight = xlMedium 'bordures
F.Columns.AutoFit 'ajustement largeurs
F.Activate 'facultatif
End Sub

Je verrai demain pour le comptage des occurrences.

Bonne nuit.

chinel · 23 Décembre 2022

job75 à dit:

Je comprends que vous voulez archiver les affectations alors voyez ce fichier (2) et la macro du bouton :

VB:

Sub Archivage()
If MsgBox("Avez-vous bien vérifié les affectations ?", vbYesNo + vbQuestion, "Archivage") = vbNo Then Exit Sub
Dim F As Worksheet, lig&, c As Range, n%
Set F = Sheets("Personnel")
lig = F.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
For Each c In Sheets("Planning").[B8,B10:B15,G8,G10:G15,B17,B19:B22,G17,G19:G23,B25:B29] 'plage adaptable
    n = n + 1
    F.Cells(lig, n) = c
Next
F.Cells(lig, 1).Resize(, n).Borders.Weight = xlMedium 'bordures
F.Columns.AutoFit 'ajustement largeurs
F.Activate 'facultatif
End Sub

Je verrai demain pour le comptage des occurrences.

Bonne nuit.

super boulot, merci peut-on incorporer la date du planning à chaque fois qu'on archive et aussi éviter de mettre la même personne sur 2 machines en même temps avec un message exemple: " Attention Olivier est déjà occupé sur une machine". Merci encore pour votre aide, bonne journée

job75 · 23 Décembre 2022

Bonjour chinel, le forum,

Voyez ce fichier (3) avec :

1) le code de la feuille "Planning" pour éviter les doublons :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B:B,G:G]) Is Nothing Then Exit Sub
Application.EnableEvents = False 'désactive les évènements
If Target.Count > 1 Then Application.Undo: GoTo 1 'annule les entrées ou effacements multiples
If Target = "" Or (Application.CountIf([B:B], Target) + Application.CountIf([G:G], Target)) = 1 Then GoTo 1
Target.Select
MsgBox "Cet ouvrier est déjà affecté à une autre machine !", 48, "Doublon"
Target = ""
1 Application.EnableEvents = True 'réactive les évènements
End Sub

2) les codes des boutons dans Module1 :

VB:

Sub Archivage()
If MsgBox("Avez-vous bien vérifié les affectations ?", vbYesNo + vbQuestion, "Archivage") = vbNo Then Exit Sub
Dim F As Worksheet, lig&, c As Range, n%
Set F = Sheets("Personnel")
lig = F.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
F.Cells(lig, 1) = Sheets("Planning").[B1] 'date
For Each c In Sheets("Planning").[B8,B10:B15,G8,G10:G15,B17,B19:B22,G17,G19:G23,B25:B29] 'plage adaptable
    n = n + 1
    F.Cells(lig, n + 1) = c.Value
Next
F.Cells(lig, 1).Resize(, n + 1).Borders.Weight = xlMedium 'bordures
F.Columns.AutoFit 'ajustement largeurs
F.Activate 'facultatif
End Sub

Sub Comptage()
UserForm1.Show 0 'non modal
End Sub

3) le code de l'UserForm :

VB:

Private Sub ComboBox1_Change()
If ComboBox1.ListIndex > -1 And ComboBox2.ListIndex > -1 Then _
    TextBox1 = Application.CountIf(Sheets("Personnel").Columns(ComboBox1.ListIndex + 2), ComboBox2.Text) Else TextBox1 = ""
End Sub

Private Sub ComboBox2_Change()
ComboBox1_Change
End Sub

Les listes des 2 ComboBox sont définies par leur propriété RowSource.

A+

chinel · 23 Décembre 2022

job75 à dit:

Bonjour chinel, le forum,

Voyez ce fichier (3) avec :

1) le code de la feuille "Planning" pour éviter les doublons :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B:B,G:G]) Is Nothing Then Exit Sub
Application.EnableEvents = False 'désactive les évènements
If Target.Count > 1 Then Application.Undo: GoTo 1 'annule les entrées ou effacements multiples
If Target = "" Or (Application.CountIf([B:B], Target) + Application.CountIf([G:G], Target)) = 1 Then GoTo 1
Target.Select
MsgBox "Cet ouvrier est déjà affecté à une autre machine !", 48, "Doublon"
Target = ""
1 Application.EnableEvents = True 'réactive les évènements
End Sub

2) les codes des boutons dans Module1 :

VB:

Sub Archivage()
If MsgBox("Avez-vous bien vérifié les affectations ?", vbYesNo + vbQuestion, "Archivage") = vbNo Then Exit Sub
Dim F As Worksheet, lig&, c As Range, n%
Set F = Sheets("Personnel")
lig = F.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
F.Cells(lig, 1) = Sheets("Planning").[B1] 'date
For Each c In Sheets("Planning").[B8,B10:B15,G8,G10:G15,B17,B19:B22,G17,G19:G23,B25:B29] 'plage adaptable
    n = n + 1
    F.Cells(lig, n + 1) = c.Value
Next
F.Cells(lig, 1).Resize(, n + 1).Borders.Weight = xlMedium 'bordures
F.Columns.AutoFit 'ajustement largeurs
F.Activate 'facultatif
End Sub

Sub Comptage()
UserForm1.Show 0 'non modal
End Sub

3) le code de l'UserForm :

VB:

Private Sub ComboBox1_Change()
If ComboBox1.ListIndex > -1 And ComboBox2.ListIndex > -1 Then _
    TextBox1 = Application.CountIf(Sheets("Personnel").Columns(ComboBox1.ListIndex + 2), ComboBox2.Text) Else TextBox1 = ""
End Sub

Private Sub ComboBox2_Change()
ComboBox1_Change
End Sub

Les listes des 2 ComboBox sont définies par leur propriété RowSource.

A+

Merci job75 de ton soutien, je regarde plus tard car ici, je bosse.

chinel · 23 Décembre 2022

job75 à dit:

Bonjour chinel, le forum,

Voyez ce fichier (3) avec :

1) le code de la feuille "Planning" pour éviter les doublons :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B:B,G:G]) Is Nothing Then Exit Sub
Application.EnableEvents = False 'désactive les évènements
If Target.Count > 1 Then Application.Undo: GoTo 1 'annule les entrées ou effacements multiples
If Target = "" Or (Application.CountIf([B:B], Target) + Application.CountIf([G:G], Target)) = 1 Then GoTo 1
Target.Select
MsgBox "Cet ouvrier est déjà affecté à une autre machine !", 48, "Doublon"
Target = ""
1 Application.EnableEvents = True 'réactive les évènements
End Sub

2) les codes des boutons dans Module1 :

VB:

Sub Archivage()
If MsgBox("Avez-vous bien vérifié les affectations ?", vbYesNo + vbQuestion, "Archivage") = vbNo Then Exit Sub
Dim F As Worksheet, lig&, c As Range, n%
Set F = Sheets("Personnel")
lig = F.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1
F.Cells(lig, 1) = Sheets("Planning").[B1] 'date
For Each c In Sheets("Planning").[B8,B10:B15,G8,G10:G15,B17,B19:B22,G17,G19:G23,B25:B29] 'plage adaptable
    n = n + 1
    F.Cells(lig, n + 1) = c.Value
Next
F.Cells(lig, 1).Resize(, n + 1).Borders.Weight = xlMedium 'bordures
F.Columns.AutoFit 'ajustement largeurs
F.Activate 'facultatif
End Sub

Sub Comptage()
UserForm1.Show 0 'non modal
End Sub

3) le code de l'UserForm :

VB:

Private Sub ComboBox1_Change()
If ComboBox1.ListIndex > -1 And ComboBox2.ListIndex > -1 Then _
    TextBox1 = Application.CountIf(Sheets("Personnel").Columns(ComboBox1.ListIndex + 2), ComboBox2.Text) Else TextBox1 = ""
End Sub

Private Sub ComboBox2_Change()
ComboBox1_Change
End Sub

Les listes des 2 ComboBox sont définies par leur propriété RowSource.

A+

super travail ! Ce qui m'embête, c'est l'userform car j'aurai préféré sur une feuille, mais comment agencer ça ? Je ne sais pas comment faire, mais je pensais plutôt comme l'image

job75 · 23 Décembre 2022

Si vous préférez un tableau à double entrée voyez ce fichier (4) et la feuille "Comptage".

Pas besoin de VBA, formule en B3 =NB.SI(INDEX(T;;LIGNE()-1);B$2)

T étant la plage nommée par la macro Archivage.

Les valeurs zéro sont masquées par le format personnalisé 0;;

chinel · 23 Décembre 2022

job75 à dit:
Si vous préférez un tableau à double entrée voyez ce fichier (4) et la feuille "Comptage".

Pas besoin de VBA, formule en B3 =NB.SI(INDEX(T;;LIGNE()-1);B$2)

T étant la plage nommée par la macro Archivage.

Les valeurs zéro sont masquées par le format personnalisé 0;;

Alors là, on frôle la perfection ! C'est vrai superrrrrrrrr ! Merci beaucoup !!! Je vous souhaite de bonnes fêtes de fin d'année et mes meilleurs voeux pour 2023 !

XL 2019 copier cellule dans une autre feuille en colonne

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

job75​

job75​

XLDnaute Impliqué

Phil69970​

XLDnaute Barbatruc

XLDnaute Impliqué

Phil69970​

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

XLDnaute Impliqué

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Impliqué

Discussions similaires

Partager cette page

Statistiques des forums

job75

job75

Phil69970

Phil69970