Discussion :

[salemhacen]

Bonjour,

Je suis débutant avec VBA, j'ai besoin de votre aide,
J'ai un fichier Excel qui comporte 9 colonnes et plusieurs lignes, dans ce fichier on trouve des personnes avec leurs historiques de formations.
Ce que je souhaite faire c'est de créer une macro qui permet:
- en indiquant le code d'une formation (colonne D) me copie toutes les données dans un autre onglet que je nommerais au nom de la formation recherchée.
je le fais déjà manuellement puisque dans le filtre de la colonne D je choisi ma formation ensuite je sélectionne tout et je le recopie dans un autre onglet donc mon souhait et d'automatiser cette fonction sachant que j'en ai pour 20 formations je souhaite les récupérer toutes dans d'autres onglets.

Par avance merci.

[Invité]

Bonjour,
regarde ça:http://www.developpez.net/forums/d13...s/#post7481714

[salemhacen]

Merci "rdurupt" pour la réponse, depuis tout à l'heure j'essaye d'adapter ce code sur ma base mais en vain, quand je l’exécute il passe mais au résultat il ne me copie rien du tout la page reste vide...

[Invité]

Poste ton code!

[Marc-L]

Bonjour,

à la place d'un filtre, utiliser un filtre avancé copiant directement les données …



_____________________________________________________________________________________________________
Je suis Charlie - Je suis Bardo

[salemhacen]

Voici le code,

il ne marche pas il m'indique erreur d’exécution '9', il me crée un onglet et un nouveau classeur c'est pas bon aussi.

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
Private Sub CommandButton1_Click()
 
 If Me.TextBox1.Text = "" Then
    MsgBox "Veuillez indiquer votre formation, merci."
    Me.TextBox1.SetFocus
Exit Sub
End If
 
 'création d'une feuille pour y copier les données
Dim sh As Worksheet
Set sh = Worksheets.Add
sh.Name = TextBox1
 
' Rechercher dans la liste, Rapport1 voulu
 Dim LastLign As Long ' Dernière ligne de la liste dans la feuille Rapport1
 Dim Pcellule As Range 'Première cellule trouver
 Dim Num As String 'Code d'identification
 Dim WbActif As Workbook
 Dim WbFiltre As Workbook
 Set WbActif = ActiveWorkbook
 Set WbFiltre = Workbooks.Add
 WbFiltre.Sheets(Rapport1).Range("A1") = sh.Range("A1")
 
 LastLign = WbActif.Worksheets("Rapport1").UsedRange.Rows.count + 1
 FiltreActif sh.UsedRange, WbFiltre.Sheets(Rapport1).UsedRange, WbActif.Worksheets("Rapport1").Cells(LastLign, 1), False
    WbFiltre.Close False
 WbActif.Worksheets("Rapport1").Cells(LastLign, 1).EntireRow.Delete
 
NewLign = 2
Num = TextBox1
 
With Worksheets("Rapport1").Range("B1:B" & LastLign)
    Set c = .Find(Num)
    Set Pcellule = c 'enregistre le premier élémént trouver
  If Not c Is Nothing Then
   Do
       c.EntireRow.copy Destination:=Worksheets(TextBox1).Range("B" & NewLign) 'copie la ligne dans l'autre feuille
       Set c = .FindNext(c) ' recherche si il y a un autre code dans la liste
       NewLign = NewLign + 1
   Loop While Not c Is Nothing And c <> Pcellule
End If
End With
 
 
 
End Sub
Function FiltreActif(RangeSource As Range, CriterRange As Range, CopyRange As Range, Optional Unique As Boolean = True) As Boolean
FiltreActif = False
On Error Resume Next
 RangeSource.AdvancedFilter Action:= _
        xlFilterCopy, CriteriaRange:=CriterRange _
        , CopyToRange:=CopyRange, Unique:=Unique
        DoEvents
        If Err = 0 Then FiltreActif = True
        MsgBox Err.Description
        On Error GoTo 0
End Function

ce que je souhaite faire: dans l'onglet rapport 1 j'ai beaucoup de formations pour beaucoup de personnes, une seule personne peut avoir plusieurs formations, donc manuellement sur la colonne 'D' (code formation) je sélectionne la formation souhaite et j'affiche l'effectif avec nom prénom matricule etc...
Je veux automatiser tout ça avec VBA, je lui donne le code il me copie les données dans un autre onglet.

Merci

[Invité]

Bonjour,
un filtre élaboré sous entend des valeurs

Champ1	Champ2
toto	Vrai
titi	Faut

les valeurs sur une même colonne c'est un Ou (OR)
les valeurs sur une même ligne c'est un Et (AND)

Code :

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

1
2
3
4
5
6
7
 
WbFiltre.Sheets(Rapport1).Range("A1") = sh.Range("A1")
WbFiltre.Sheets(Rapport1).Range("A2") = "TOTO"
 
 
LastLign = WbActif.Worksheets("Rapport1").UsedRange.Rows.Count + 1
FiltreActif sh.UsedRange, WbFiltre.Sheets(Rapport1).UsedRange, WbActif.Worksheets("Rapport1").Cells(LastLign, 1), False

[salemhacen]

Je ne réussi toujours pas,
voici mon code qui me permets de tout copier de Rapport1 à Feuil2, je veux rajouter une codition celle de me copier uniquement toutes les lignes qui correspondent à une donnée D1 qu'est ce que je dois rajouter ?

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub Copier()
 
Sheets("Rapport1").Range("A1:J1000").Copy
With Sheets("Feuil2").Range("A1:J1000")
    .PasteSpecial Paste:=xlPasteValues
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteFormats
    .Application.CutCopyMode = False
End With
End Sub

[Invité]

si je t'ai proposé un filtre élaboré c'est parce que ça répond bien à ta demande.

un filtre élaboré fonctionne en fonction de 3 informations!
1) la plage de données brut non filtré
2) la plage de critères (Filtre)
3) la destination la cellule ou tu veux placer tes données

données brut

Champ1	Champ2	Champ3
Toto	Vrai	25 ans
TITI	Faut	70 Ans

Filtre

Champ3
70 Ans

Destination

Champ1	Champ2	Champ3
Cells A50

Code :

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

1
2
3
FiltreActif sheet("données brut").UsedRange, Sheets("Filtre").UsedRange, Sheets("Destination").Range("A50"), False

[salemhacen]

Bonsoir,

Je reviens vers vous voilà jusqu'à maintenant j'ai réussi à faire ce que je veux, voici le code qui me permets de filtrer selon le critère de mon choix:

Code :

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

1
2
3
4
5
6
Sub Export()
 Sheets("Rapport1").Range("A1:J300000").AdvancedFilter _
         Action:=xlFilterCopy, _
         CriteriaRange:=Sheets("FTS2").Range("D1:D2"), _
         CopyToRange:=Sheets("Feuil3").Range("A1"), _
         Unique:=False

Maintenant je souhaite mettre tout ça au propre donc ma première question :
1) Je travaille avec deux fichiers excel (deux feuilles de calculs) avec beaucoup d'onglet, mes critères de filtres existent sur le deuxième fichier, est ce que je peux faire appel à un onglet dans ce fichier en travaillant sur le premier. Si oui comment j’écris le code.
2) Dans le code si dessus je n'arrive pas à écrire entre les ligne puisque à la fin on trouve '_' est ce je peux simplifier ce code ou bien c'est quoi la solution si dans ce code je souhaite créer une nouvelle feuille de calcul.

Par avance Merci;

[Invité]

Code :

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

1
2
3
4
5
workbooks("classeur1.xls").Sheets("Rapport1").Range("A1:J300000").AdvancedFilter _
 Action:=xlFilterCopy, _
 CriteriaRange:=workbooks("classeur2.xls").Sheets("FTS2").Range("D12"), _
 CopyToRange:=workbooks("classeur3.xls").Sheets("Feuil3").Range("A1"), _
 Unique:=False

[salemhacen]

Bonjour,

Voilà mon code mais j'ai l'erreur 'Erreur d'exécution '1004':
'Erreur définie par l'application ou par l'objet'

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
 
Sub Export1()
Workbooks("HISTORIQUE_MT_VJ 20avril2015.xls").Sheets("Rapport1").Range("A1:J300000").AdvancedFilter _
         Action:=xlFilterCopy, _
         CriteriaRange:=Workbooks("Liste code SAP.xls").Sheets("FTS2").Range("A1:K2"), _
         CopyToRange:=Workbooks("HISTORIQUE_MT_VJ 20avril2015.xls").Sheets("Feuil1").Range("A1"), _
         Unique:=False
 
Workbooks("HISTORIQUE_MT_VJ 20avril2015.xls").Sheets("Rapport1").Range("A1:J300000").AdvancedFilter _
         Action:=xlFilterCopy, _
         CriteriaRange:=Workbooks("Liste code SAP.xls").Sheets("SFR1H").Range("A1:K20"), _
         CopyToRange:=Workbooks("HISTORIQUE_MT_VJ 20avril2015.xls").Sheets("Feuil2").Range("A1"), _
         Unique:=False
 
 
Workbooks("HISTORIQUE_MT_VJ 20avril2015.xls").Sheets("Rapport1").Range("A1:J300000").AdvancedFilter _
         Action:=xlFilterCopy, _
         CriteriaRange:=Workbooks("Liste code SAP.xls").Sheets("EWIS").Range("A1:A6"), _
         CopyToRange:=Workbooks("HISTORIQUE_MT_VJ 20avril2015.xls").Sheets("Feuil3").Range("A1"), _
         Unique:=False
 
End Sub

Par avance merci.