Extraction de données via bouton VBA

Version imprimable

20/09/2019, 10h47
Momo_Ouzz

1 pièce(s) jointe(s)

Extraction de données via bouton VBA

Bonjour à tous,

J'ai un petit soucis je cherche à appliquer depuis quelques jours une macro (via un bouton) à mon fichier afin de pouvoir extraire les informations du tableau si la colonne G contient le chiffre 90 vers la feuille Réf Inactive à partir de la cellule A7.

Etant novice en VBA je n'ai pas la moindre idée de comment m'y prendre, j’espère que cela est réalisable en tout cas je compte voir comment est structuré le code car c'est une macro que je vais sans doute utiliser pour différent fichier.

Merci d'avance pour votre aide.

1 pièce(s) jointe(s)

bonjour
à tester
NB : j'ai supprimer bq de lignes pour pouvoir t'envoyer un fichier exemple

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub extraction()
Application.ScreenUpdating = False
Dim sh As Worksheet
 On Error Resume Next
For Each sh In Sheets
    sh.ShowAllData
Next sh
 
   Dim derlig As Long
  Dim F1 As Worksheet
  Dim F2 As Worksheet
  Set F1 = Sheets("Liste de Groupe Appro_1")
  Set F2 = Sheets("Ref Inactive")
derlig = F2.Range("A" & Rows.Count).End(xlUp).Row
  F2.Range("A7:H" & derlig).ClearContents
F1.Range("A6", "H" & F1.Range("A" & F1.Rows.Count).End(xlUp).Row).AutoFilter Field:=7, Criteria1:="90"
F1.Range("A6:H100000").SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("A7")
Application.ScreenUpdating = True
End Sub

20/09/2019, 13h29
Momo_Ouzz

Bonjour BENNASR,

Je vais tester ça de suite et je reviens vers vous.

merci beaucoup
20/09/2019, 13h43
Momo_Ouzz

Bonjour BENNASR,

Merci c'est Niquel. Je vais regarder le code d'un peu plus près afin de le comprendre pour pouvoir ajouter des modif si besoin.

Cdlt,

Extraction VBA

Bonjour BENNASR,

J'ai quelque peut modifié le code pour avoir un autre point de recherche. Et j'aimerais ajouter une condition mais je bloque :

La condition serait : que la colonne deux me sorte uniquement les noms contenant STOP USE ou STOP. en plus du code précedant qui dit récuperer les données de la colonne 3 ne contenant pas "90".

Merci beaucoup,
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Sub Bouton1_Cliquer() Application.ScreenUpdating = False Dim sh As Worksheet On Error Resume Next For Each sh In Sheets sh.ShowAllData Next sh Dim derlig As Long Dim F1 As Worksheet Dim F2 As Worksheet Set F1 = Sheets("No FA") Set F2 = Sheets("Statut No 90") derlig = F2.Range("A" & Rows.Count).End(xlUp).Row F2.Range("A4:Y" & derlig).ClearContents F1.Range("A1", "Y" & F1.Range("A" & F1.Rows.Count).End(xlUp).Row).AutoFilter Field:=3, Criteria1:="<>90", _ Operator:=xlAnd F1.Range("A1:Y100000").SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("A4") Application.ScreenUpdating = True End Sub

bonjour
à tester

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub extraction()
Application.ScreenUpdating = False
Dim sh As Worksheet
 On Error Resume Next
For Each sh In Sheets
    sh.ShowAllData
Next sh
 
   Dim derlig As Long
  Dim F1 As Worksheet
  Dim F2 As Worksheet
  Set F1 = Sheets("Liste de Groupe Appro_1")
  Set F2 = Sheets("Ref Inactive")
derlig = F2.Range("A" & Rows.Count).End(xlUp).Row
  F2.Range("A7:H" & derlig).ClearContents
F1.Range("A6", "H" & F1.Range("A" & F1.Rows.Count).End(xlUp).Row).AutoFilter Field:=7, Criteria1:="<>90"
F1.Range("A6", "H" & F1.Range("A" & F1.Rows.Count).End(xlUp).Row).AutoFilter Field:=2, Criteria1:="*ML*", Operator:=xlOr, Criteria2:="*STOP USE*"
F1.Range("A6:H100000").SpecialCells(xlCellTypeVisible).Copy Destination:=F2.Range("A7")
Application.ScreenUpdating = True
 
End Sub

01/10/2019, 17h04
Momo_Ouzz

Bonjour,

Merci cela fonctionne ;)

1 pièce(s) jointe(s)

Question VBA

Bonjour BENNASR,

je suis un peux bloqué sur un autre sujet.

Je vous explique mon cas :

Si un code fournisseur(colonne A) possède un type d'adresse "2"(Colonne Q) alors on supprime toutes les infos de ce code fournisseur. (Car un code fournisseur peut avoir plusieurs type d'adresse "1" "2" "10"...). Don on supprime toute les lignes avec ce codes fournisseurs qui possède 2 en Colonne Q.

Voici ce que je recherche à faire je vous partage le fichier.

Vous verrez que le code fournisseurs peut apparaître sur plusieurs lignes et que si on retrouve 2 (en colonne Q) pour ce fournisseurs on peut supprimer ce numéro fournisseurs et toutes les infos correspondantes. Par ailleurs j'ai masqué les colonne C à P pour que ce soit plus lisible.

Il n'y a pas toute les ref mais on peut compter 3000 lignes en tout.

Voici la macro que j'ai pu trouver :
Code:

1 2 3 4 5 6 7 8 Sub supprimerLig() derLig = Range("A" & Rows.Count).End(xlUp).Row For i = derLig To 2 Step -1 '(on suppose que la première ligne est l'entête) If Cells(i, "Q") = 2 Then Rows(i).EntireRow.Delete End If Next i End Sub
Je vous partage le fichier exemple. Pièce jointe 509156

bonjour
normalement le code fonctionne
juste quelques améliorations
A tester sur une copie de ton travail pour éviter tous risque de perte de données

Code:

1
2
3
4
5
6
7
8
9
10
11
Option Explicit
Sub supprimerLig()
Dim derlig As Long
Dim i As Long
Dim F As Worksheet
Set F = Sheets("feuil1")
    derlig = F.Range("A" & Rows.Count).End(xlUp).Row
    For i = derlig To 2 Step -1 '(on suppose que la première ligne est l'entête)
        If F.Cells(i, "Q") = 2 Then Rows(i).EntireRow.Delete
    Next i
End Sub

11/10/2019, 11h01
Momo_Ouzz

Bonjour,

Celle ci fonctionne par contre elle me supprime les lignes ou il n'y a que le 2 en colonne Q Hors j'aimerais que si un code fournisseurs (en colonne A) possède 2 en colonne Q les lignes du code fournisseurs soit supprimé aussi.

Exemples

70221803 A 5 LIVR

70221803 A 10

70221803 A 2 FACFR1

Voila ce sont les 3 premières lignes de la pièce jointe.

On remarque qu'on a le même code fournisseurs et que le 2 apparaît dans une des lignes. SI ce 2 est présents je souhaite supprimer toutes les lignes avec le même code fournisseurs.

Merci pour votre aide.

à tester sur une copie de w

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
Sub supprimerLig()
Dim derlig As Long
Dim i As Long
Dim j As Long
Dim CodFours As String
Dim F As Worksheet
Set F = Sheets("feuil1")
    derlig = F.Range("A" & Rows.Count).End(xlUp).Row
    For i = derlig To 2 Step -1
        If F.Cells(i, "Q") = 2 Then CodFours = F.Cells(i, "A")
            For j = derlig To 2 Step -1
                If F.Cells(j, "A") = CodFours Then Rows(j).EntireRow.Delete
            Next j
    Next i
End Sub

Ajoute un onglet (nommé Feuil2) et copie ce code:
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 Option Explicit Sub supprimerLig() Dim derlig As Long Dim Dligne As Long Dim i As Long Dim J As Long Dim k As Long derlig = Sheets("Feuil1").Range("A150000").End(xlUp).Row Dligne = Sheets("Feuil2").Range("A150").End(xlUp).Row For i = derlig To 2 Step -1 If Cells(i, "Q") = "2" Then Sheets("Feuil2").Cells(Dligne + 1, 1) = Cells(i, 1) Dligne = Sheets("feuil2").Range("A1500").End(xlUp).Row Next i For J = Dligne To 2 Step -1 For k = derlig To 2 Step -1 If Cells(k, 1) = Sheets("Feuil2").Cells(J, 1) Then Rows(k).Delete Next k Next J Sheets("Feuil2").Range("A1:A" & Dligne).ClearContents End Sub
Cela dit, sans vouloir jouer les moralisateurs, tu n'as absolument pas pris la peine de prendre part au développement des codes dont tu avais besoin, d'autant que ceux-ci n'étaient pas impossibles à surmonter, même pour un débutant qui se renseigne un peu ci et là (c'est mon cas).

A court terme cela fonctionne car des personnes bien intentionnées comme BENNASR se proposent de rendre service, mais pour ta propre connaissance (d'autant que tu es alternant visiblement), peut-être est-il judicieux de t'impliquer davantage dans la rédaction du code ?

Mickamax

11/10/2019, 13h59
Momo_Ouzz

Merci BENNASR votre code fonctionne parfaitement.

Je vais le découper afin de pouvoir l'expliquer surtout le terme CodFour (que je ne connaissais pas).

Merci beaucoup.

70221803	A	5	LIVR
70221803	A	10
70221803	A	2	FACFR1