Remplir un tableau à partir d'un autre tableau Excel ?

**Atef haggui** · 25/12/2019, 10h20

J'ai besoin d'un macro pour remplir un tableau dans la feuille 2 à partir d'un autre tableau excel dans la feuille 1 selon deux critére Poste de travail 1;2;3 et ligne 1;2;3;5;6;7;8;9;10.
Merci d'avance pour votre aide.

**BENNASR** · 25/12/2019, 13h53

bonjour et bienvenue ATEF
Pourquoi ne pas faire avec un TCD avec comme segment la poste et la ligne surtout que normalement tu maîtrise pas VBA ??
Aussi je constate que don ton fichier exemple tu n'as que l5 et l6
Aussi est il nécessaire de faire des tableaux avec chaque fois 7 et exactement 7 lignes ?? d'ailleurs si je filtre Equipe 1 et L5 je trouve 74 employés comment faire dans ce cas ??
Je pense aussi à l'historique des affectation .....
Je crois qu'avant d'entamer la programmation il faut bien penser à tes besoins futurs et actuels
BONNE CONTINUATION

**Atef haggui** · 25/12/2019, 15h25

Je veux le faire avec VBA car c'est pas à moi de la manipuler.
Merci pour pour votre réponse.

**BENNASR** · 25/12/2019, 15h41

Rebonjour ATEF , la forum
beaucoup de question lors de ma précédente intervention reste sans réponse dont la structure de tes tableaux qui vont recevoir les données qui réponds aux deux conditions
Mais le principe en général, à mon modeste avis (à adapter pour tes besoins) :
un userform et un bouton de commande ; choisir l'équipe en combobox1 et la ligne en combobox2 puis cliquer sur le bouton de commande
( filtrer et envoyer les données)
NB : je suis autodidacte et débutant donc à tester avec prudence

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Private Sub CommandButton1_Click()
Dim F1 As Worksheet
Dim F2 As Worksheet
Set F1 = Sheets("EMPLOYE")
Set F2 = Sheets("AFFECTATION")
 
Application.ScreenUpdating = False
 
derlig = F2.Range("B" & Rows.Count).End(xlUp).Row
derlig2 = F1.Range("A" & Rows.Count).End(xlUp).Row
  If derlig >= 10 Then F2.Range("B10:F" & derlig).ClearContents
 With F1
    If Not .AutoFilter Is Nothing Then
      If .FilterMode Then .ShowAllData
      .AutoFilter.Range.AutoFilter
    End If
i = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A1:E" & i).AutoFilter Field:=4, Criteria1:=ComboBox1.Value
.Range("A1:E" & i).AutoFilter Field:=5, Criteria1:=ComboBox2.Value
F2.Activate
F1.Range("A2:B" & derlig2).SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("B10")
 
 
End With
F2.Cells(3, 4) = Date
F2.Cells(5, 4) = ComboBox1.Value
F2.Cells(7, 4) = ComboBox2.Value
 
F1.Range("A1:E" & derlig2).AutoFilter Field:=1
 
F2.Select
 Application.ScreenUpdating = True
 
End Sub
 
Private Sub UserForm_Initialize()
 
Dim F1 As Worksheet
Dim F2 As Worksheet
Set F1 = Sheets("EMPLOYE")
Set F2 = Sheets("AFFECTATION")
 
 With F1
    If Not .AutoFilter Is Nothing Then
      If .FilterMode Then .ShowAllData
      .AutoFilter.Range.AutoFilter
    End If
End With
 
Dim i As Integer
For i = 2 To F1.Range("D65536").End(xlUp).Row
  ComboBox1 = F1.Range("D" & i)
  ComboBox2 = F1.Range("E" & i)
  If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem F1.Range("D" & i)
  If ComboBox2.ListIndex = -1 Then ComboBox2.AddItem F1.Range("E" & i)
Next i
ComboBox1.Value = ""
ComboBox2.Value = ""
 
End Sub

**Atef haggui** · 26/12/2019, 09h14

Merci pour votre réponse

mais ça affiche l'erreur en image ci-joint

**BENNASR** · 26/12/2019, 09h19

bonjour
avez vous changer le nom des onglets??
feuil1 et feuil2 ??

**BENNASR** · 26/12/2019, 09h27

tester ça :

**Atef haggui** · 26/12/2019, 10h30

Envoyé par BENNASR

tester ça :

ça marche pour le premier mais je veux afficher les nom en arabe.
Merci

**BENNASR** · 26/12/2019, 10h42

que le nom en rabe ou les deux??
à tester

**Atef haggui** · 26/12/2019, 10h56

Envoyé par BENNASR

que le nom en rabe ou les deux??
à tester

Bonjour, on doit avoir le choix

**BENNASR** · 26/12/2019, 14h16

Bonjour ATEF, la forum
Pour une bonne présentation je me trouve obliger de supprimer, avec code, des espaces devant les nom en langue française aussi des espace je crois avec (ALT + Entrée) devant les noms en arabe. De même je conseille d'éviter le renvoie automatique à la ligne !! et vivement déconseillé de faire la fusion des cellules
voila votre fichier avec un choix de la langue au départ
Comme bonus et cadeau de fin de l'année j'ai ajouter automatiquement à la fin de traitement deux ligne , la première pour saisir le chef de l'atelier et en deuxième ligne réservée pour ses remarques
J'espère que ça t'aide à avancer et de bien étudier le code (bien que c'est le travail d'un autodidacte) pour comprendre le fonctionnement
Le code :
initialisation USF

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub UserForm_Initialize()
 
Dim F1 As Worksheet
Dim F2 As Worksheet
Set F1 = Sheets("EMPLOYE")
Set F2 = Sheets("AFFECTATION")
 
Dim i As Integer
For i = 2 To F1.Range("D65536").End(xlUp).Row
  ComboBox1 = F1.Range("D" & i)
  ComboBox2 = F1.Range("E" & i)
  If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem F1.Range("D" & i)
  If ComboBox2.ListIndex = -1 Then ComboBox2.AddItem F1.Range("E" & i)
Next i
ComboBox1.Value = ""
ComboBox2.Value = ""
End Sub

Bouton de commande

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
Private Sub CommandButton1_Click()
Dim F1 As Worksheet
Dim F2 As Worksheet
Set F1 = Sheets("EMPLOYE")
Set F2 = Sheets("AFFECTATION")
F2.Range("B10:F500").Borders.LineStyle = xlLineStyleNone
Application.ScreenUpdating = False
If OptionButton1 = False And OptionButton2 = False Then
MsgBox ("Liste en Arabe ou en Français !!! merci de choisir")
Exit Sub
Else
derlig = F2.Range("B" & Rows.Count).End(xlUp).Row
derlig2 = F1.Range("A" & Rows.Count).End(xlUp).Row
For Each cell In F1.Range("B2:B" & derlig2)
    cell.Value = LTrim(cell.Value)
 Next
  If derlig >= 10 Then F2.Range("B10:F20000").ClearContents
 
 With F1
i = .Cells(Rows.Count, 1).End(xlUp).Row
.Range("A1:E" & i).AutoFilter Field:=4, Criteria1:=ComboBox1.Value
.Range("A1:E" & i).AutoFilter Field:=5, Criteria1:=ComboBox2.Value
X = .Range("A1:E" & i).SpecialCells(xlCellTypeVisible).Count
 
On Error Resume Next
If OptionButton1 = True Then
F1.Range("A2:B" & derlig2).SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("B10")
F2.Range("B10:C" & derlig2).HorizontalAlignment = xlLeft
F2.Range("B10:C" & derlig2).VerticalAlignment = xlBottom
F2.Range("B10:C" & derlig2).RowHeight = 25
F2.Range("B10:C" & derlig2).Font.Size = 11
F2.Range("B10:C" & derlig2).Font.Bold = False
For Each cell In F2.Range("B10:B500")
    cell.Value = Trim(cell.Value)
 Next
 
Else
F1.Range("A2:A" & derlig2).SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("B10")
F1.Range("C2:C" & derlig2).SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("C10")
F2.Range("B10:C" & derlig2).HorizontalAlignment = xlRight
F2.Range("B10:C" & derlig2).VerticalAlignment = xlBottom
F2.Range("B10:C" & derlig2).ShrinkToFit = True
F2.Range("B10:C" & derlig2).WrapText = False
F2.Range("B10:C" & derlig2).RowHeight = 25
F2.Range("B10:C" & derlig2).Font.Size = 13
F2.Range("B10:C" & derlig2).Font.Bold = False
End If
End With
derlig = F2.Range("B" & Rows.Count).End(xlUp).Row
Dim cellule As Range
For Each cellule In F2.Range("B10:B" & derlig2)
If cellule.Value <> "" Then F2.Range(F2.Cells(cellule.Row, 2), F2.Cells(cellule.Row, 6)).Borders.Weight = xlThin
Next
 
F2.Cells(3, 4) = Date
F2.Cells(5, 4) = ComboBox1.Value
F2.Cells(7, 4) = ComboBox2.Value
F2.Cells(derlig + 2, 3).Value = "Chef Atelier : "
F2.Cells(derlig + 2, 3).RowHeight = 35
F2.Cells(derlig + 2, 3).Font.Size = 14
F2.Cells(derlig + 2, 3).Font.Bold = True
F2.Cells(derlig + 2, 3).Borders.Weight = xlThin
F2.Range("D" & derlig + 2, ("F" & derlig + 2)).Borders.Weight = xlThin
F2.Range("E" & derlig + 2).Borders(xlEdgeRight).LineStyle = xlNone
F2.Range("E" & derlig + 2).Borders(xlEdgeLeft).LineStyle = xlNone
 
F2.Cells(derlig + 3, 3).Value = "Commentaire : "
F2.Cells(derlig + 3, 3).RowHeight = 35
F2.Cells(derlig + 3, 3).Font.Bold = True
F2.Cells(derlig + 3, 3).Font.Size = 14
F1.Range("A1:E" & derlig2).AutoFilter Field:=1
F2.Cells(derlig + 3, 3).Borders.Weight = xlThin
F2.Range("D" & derlig + 3, ("F" & derlig + 3)).Borders.Weight = xlThin
F2.Range(Cells(derlig + 3, 4), Cells(derlig + 3, 6)).Borders.Weight = xlThin
F2.Range("E" & derlig + 3).Borders(xlEdgeRight).LineStyle = xlNone
F2.Range("E" & derlig + 3).Borders(xlEdgeLeft).LineStyle = xlNone
 
 With F1
    If Not .AutoFilter Is Nothing Then
      If .FilterMode Then .ShowAllData
      .AutoFilter.Range.AutoFilter
    End If
End With
 
Unload Me
 
F2.Select
MsgBox ("affactation effectuée")
End If
 Application.ScreenUpdating = True
End Sub

Tester et dire si ça te convient
Bonne Continuation

**Atef haggui** · 26/12/2019, 14h28

Merci infiniment

**BENNASR** · 26/12/2019, 14h30

pas de quoi frère
un plaisir de t'aider !!
Bonne continuation

**Atef haggui** · 30/12/2019, 09h30

Pourrez vous m'aider de corriger l'erreur #n/a recherchev dans la feuille bilan par ligne

merciii

**BENNASR** · 30/12/2019, 09h39

bonjour atef, la forum
juste ajouter SIERREUR
=SIERREUR(FORMULE();0)ce qui donne : =SIERREUR(RECHERCHEV('Bilan par Ligne'!C10;'Equipe 1'!B:J;5;0)+RECHERCHEV('Bilan par Ligne'!C10;'Equipe 2'!B:J;5;0)+RECHERCHEV('Bilan par Ligne'!C10;'Equipe 3'!B:J;5;0);0)

**BENNASR** · 30/12/2019, 09h40

Pour lecture

https://support.office.com/fr-fr/art...e-28c28311b993

**Atef haggui** · 30/12/2019, 09h48

Envoyé par BENNASR

bonjour atef, la forum
juste ajouter SIERREUR
=SIERREUR(FORMULE();0)ce qui donne : =SIERREUR(RECHERCHEV('Bilan par Ligne'!C10;'Equipe 1'!B:J;5;0)+RECHERCHEV('Bilan par Ligne'!C10;'Equipe 2'!B:J;5;0)+RECHERCHEV('Bilan par Ligne'!C10;'Equipe 3'!B:J;5;0);0)

Mais la formule marche sur les autres lignes sans si erreur est ce que ça n'affecte pas le resultat quand on ajoute si erreur ?

**BENNASR** · 30/12/2019, 09h56

(voir le lien que je t'ai envoyé ci haut )
le problème c'est quand la formule ne trouve pas un résultat
donc pour contourner ce problème il faut commencer par SIERREUR