Discussion :

[Uzgul]

Bonjour, ayant plutôt l'habitude de coder sous SAS, on me demande cette fois d'automatiser mes résultats que j'ai extrait vers Excel : d'où ma demande d'aide en VBA.

Explications :

J'ai un premier fichier contenant les données extraites contenant le type (professionnel ou amateur), le poste (attaquant ou defenseur), l'année de naissance, et des stats correspondant à la taille et au poids.
fichier1.xlsx

J'ai créé un 2e fichier, celui-ci est encore vierge. Le but étant de n'y inclure que les lignes pour lequel le type est "professionnel" et le poste "attaquant" à partir du 1er fichier (donc un copier coller automatique sous condition), juste en cliquant sur un bouton, donc à partir d'une macro.

C'est là où le problème se pose, je ne vois pas comment poser ces conditions, j'ai un premier code :

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
Sub ProAtt()
 
'
' ProAtt Macro
'
 
 
' Essayer d'ajouter des conditions
 
    Workbooks.Open Filename:= _
        "\D:\s047220\Mes Documents\Fichier_1.xls"
    ' Ouverture du premier fichier
 
    Range("A1:E1,A2:E2,A5:E5,A7:E7").Select
	'Ici j'ai donc sélectionné manuellement les données qui m'intéresse ; Comment automatiser cette recherche ? 
 
    Selection.Copy
    Windows("Fichier_2.xlsm").Activate
    Range("A1").Select
    ActiveSheet.Paste
         'Copie dans le fichier 2
 
    Windows("Fichier_1.xlsx").Activate
    Application.DisplayAlerts = False
    ActiveWindow.Close
         'Fermeture du fichier 1 
 
End Sub

Je suis sans doute influencé par mes connaissances en SAS, mais j'ai dans l'idée de passer par une étape du type :


if column(1)="professionnel" and column(2)=attaquant then
"tu copies les lignes correspondantes"

end if

Mais après pas mal d'essais infructueux et la lecture de pas mal de forums je m'en remets à vous pour quelques conseils.

Merci, et bonne journée à vous !

Uzgul.

[RyuAutodidacte]

Tu peux te tourner vers : Les filtres avancés ou élaborés dans Excel
Cela permet peut te permettre d'extraire les données voulues

[Uzgul]

Je vais regarder ton lien, merci !

[BENNASR]

bonsoir à tous
Proposition :

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
Sub test()
' nétoyer feuille 2
With Sheets("feuil2")
.Select
    Selection.ClearContents
    End With
 
Application.ScreenUpdating = False
'copier les titres des colonnes
Sheets("feuil2").Range("A1") = Sheets("base").Range("A1")
Sheets("feuil2").Range("B1") = Sheets("base").Range("B1")
Sheets("feuil2").Range("C1") = Sheets("base").Range("C1")
Sheets("feuil2").Range("D1") = Sheets("base").Range("D1")
Sheets("feuil2").Range("E1") = Sheets("base").Range("E1")
 
'copier donner selon condition
Dim Tablo
Dim i As Long
Tablo = Sheets("base").Range("A2", "E" & Sheets("base").Range("E" & Rows.Count).End(xlUp).Row)
k = 2
For i = LBound(Tablo, 1) To UBound(Tablo, 1)
    If Tablo(i, 1) = "professionnel" And Tablo(i, 2) = "attaquant" Then
    Sheets("feuil2").Range("A" & k) = Tablo(i, 1)
    Sheets("feuil2").Range("B" & k) = Tablo(i, 2)
    Sheets("feuil2").Range("C" & k) = Tablo(i, 3)
    Sheets("feuil2").Range("D" & k) = Tablo(i, 4)
    Sheets("feuil2").Range("E" & k) = Tablo(i, 5)
    k = k + 1
    End If
Next i
Application.ScreenUpdating = True
End Sub

[Uzgul]

Bonsoir, merci pour ton code il m'a bien aidé ! Je l'ai légèrement modifier pour que le transfert se fasse dans un nouveau classeur, merci encore !

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
Option Explicit
 
Sub Fin()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
 
'Chemin
Workbooks.Open Filename:="C:\Users\Uzgul\Desktop\Fichier1.xlsx"
 
 
'Mise à zéro de la feuille de réception
'Fichier2.xlsm est le fichier de travail, vierge
Windows("Fichier2.xlsm").Activate
Sheets("feuil1").Cells.ClearContents
 
'Copie de la légende 
Windows("Fichier1.xlsx").Activate
Sheets("base").Rows(1).Copy
 
'Collage de la légende
Windows("Fichier2.xlsm").Activate
Sheets("feuil1").Range("A1").Select
Selection.PasteSpecial
 
'On se place sur le fichier de source
Windows("Fichier1.xlsx").Activate
Sheets("base").Select
 
 
'Copie des données selon conditions
Application.ScreenUpdating = False
 
Dim Tablo
Dim i As Long
Dim k As Integer
 
'On met en place un tableau pour récupérer les données car beaucoup plus rapide pour copier coller
Tablo = Sheets("base").Range("A2", "E" & Sheets("base").Range("E" & Rows.Count).End(xlUp).Row)
k = 2
 
Windows("Fichier2.xlsm").Activate
 
'Boucle où l'on sélectionne uniquement le type et le poste
'On insère les données récoltées dans le nouveau classeur
For i = LBound(Tablo, 1) To UBound(Tablo, 1)
    If Tablo(i, 1) = "professionnel" And Tablo(i, 2) = "attaquant" Then
    Sheets("feuil1").Range("A" & k) = Tablo(i, 1)
    Sheets("feuil1").Range("B" & k) = Tablo(i, 2)
    Sheets("feuil1").Range("C" & k) = Tablo(i, 3)
    Sheets("feuil1").Range("D" & k) = Tablo(i, 4)
    Sheets("feuil1").Range("E" & k) = Tablo(i, 5)
 
    k = k + 1
    End If
Next i
 
'On referme le fichier source
Workbooks("Fichier1.xlsx").Close SaveChanges:=False
 
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
 
 
End Sub

Bonne soirée à tous !