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

Version imprimable

25/12/2019, 10h20
Atef haggui

1 pièce(s) jointe(s)

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

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.
25/12/2019, 13h53
BENNASR

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
25/12/2019, 15h25
Atef haggui

1 pièce(s) jointe(s)

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

1 pièce(s) jointe(s)

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:

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

26/12/2019, 09h14
Atef haggui

1 pièce(s) jointe(s)

Merci

Merci pour votre réponse :D
mais ça affiche l'erreur en image ci-joint
26/12/2019, 09h19
BENNASR

bonjour
avez vous changer le nom des onglets??
feuil1 et feuil2 ??
26/12/2019, 09h27
BENNASR

1 pièce(s) jointe(s)

tester ça :
26/12/2019, 10h30
Atef haggui

1 pièce(s) jointe(s)

Citation:

Envoyé par BENNASR

tester ça :

ça marche pour le premier mais je veux afficher les nom en arabe.
Merci :D
26/12/2019, 10h42
BENNASR

1 pièce(s) jointe(s)

que le nom en rabe ou les deux??
à tester
26/12/2019, 10h56
Atef haggui

Citation:

Envoyé par BENNASR

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

Bonjour, on doit avoir le choix :oops:

1 pièce(s) jointe(s)

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:

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:

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

26/12/2019, 14h28
Atef haggui

Merci infiniment :D
26/12/2019, 14h30
BENNASR

pas de quoi frère
un plaisir de t'aider !!
Bonne continuation
30/12/2019, 09h30
Atef haggui

1 pièce(s) jointe(s)

Pourrez vous m'aider de corriger l'erreur #n/a recherchev dans la feuille bilan par ligne :calim2: merciii
30/12/2019, 09h39
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)
30/12/2019, 09h40
BENNASR

Pour lecture

Citation:

https://support.office.com/fr-fr/art...e-28c28311b993
30/12/2019, 09h48
Atef haggui

Citation:

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 ?
30/12/2019, 09h56
BENNASR

(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
30/12/2019, 10h01
Atef haggui

1 pièce(s) jointe(s)

ça a marché pour le rendement mais pour le TMP non :aie:

PVI
30/12/2019, 10h45
BENNASR

y a pas une formule qui marche pour une colonne et non pour une autre
vérifie bien ta formule car SIERREUR(formule;0) n'affecte pas le résultat ..