XL 2013 Extraction

C

candido57

XLDnaute Occasionnel
Bonjour,
J'ai récupéré un fichier avec une macro extraction, j'ai modifier par rapport à ceux que je voulais, ça fonctionne, mais je n'arrive pas à extraire lorsque je mets une seul condition feuille "Extraction" cellule F2.
Merci pour votre aide.
 

Pièces jointes

  • Produit complémentaire 1.xls
    471.5 KB · Affichages: 4
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Bonjour

@candido57
Pourquoi avoir créér une seconde discussion ? :rolleyes:
Alors que celle-ci était déjà engagée
(et où il y a eu des réponses)
excel-downloads.com

XL 2013 - Extraction et saisi donné dans texbox

Bonjour, J'ai un fichier que j'ai récupéré et je voulais le mettre à ma sauce. Mais ça ne fonctionne pas et je suis très très novice en macro. 1) Dans la feuille Base, j'ai un clic sur entrée et je voudrais pouvoir rentrer les informations et si en tapant le n° de carte que ça vienne en auto si...
excel-downloads.com excel-downloads.com
 
Vote positif 0 Vote négatif
C

candido57

XLDnaute Occasionnel
Bonjour,

Je sais, mais ce n'est pas la même chose , le premier a été résolu " Saisi dans Userbox" et maintenant c'est l'extraction. Extraction fonctionne , mais si je mets une condition en F2 seul ça ne fonctionne pas . Je suis sûr que le problème est devant moi , mais je ne trouve pas .
 
Vote positif 0 Vote négatif
C

candido57

XLDnaute Occasionnel
Actellement j'ai ça.

Sub Extraction()
Semaine = [B2]
N°_Carte = [F2]
Articles = [H2]
[A7:J65000].ClearContents
lig = 7

If Semaine = "" Then
For Each sh In Worksheets
If Left(sh.Name, 1) = "B" Then
With Sheets(sh.Name)
For k = 5 To .[A65000].End(3).Row
If .Cells(k, 3) = N°_Carte And .Cells(k, 8) = Articles Then
Sheets("Extraction").Range("A" & lig & ":J" & lig).Value = .Range("A" & k & ":J" & k).Value
lig = lig + 1
End If
Next
End With
End If
Next
Exit Sub
End If

If N°_Carte = "" Then
For Each sh In Worksheets
If Left(sh.Name, 1) = "B" Then
With Sheets(sh.Name)
For k = 5 To .[A65000].End(3).Row
If .Cells(k, 7) = Semaine And .Cells(k, 8) = Articles Then
Sheets("Extraction").Range("A" & lig & ":J" & lig).Value = .Range("A" & k & ":J" & k).Value
lig = lig + 1
End If
Next
End With
End If
Next
Exit Sub
End If

If Articles = "" Then
For Each sh In Worksheets
If Left(sh.Name, 1) = "B" Then
With Sheets(sh.Name)
For k = 5 To .[A65000].End(3).Row
If .Cells(k, 3) = N°_Carte And .Cells(k, 7) = Semaine Then
Sheets("Extraction").Range("A" & lig & ":J" & lig).Value = .Range("A" & k & ":J" & k).Value
lig = lig + 1
End If
Next
End With
End If
Next
Exit Sub
End If

'tous
For Each sh In Worksheets
If Left(sh.Name, 1) = "B" Then
With Sheets(sh.Name)
For k = 5 To .[A65000].End(3).Row
If .Cells(k, 3) = N°_Carte And .Cells(k, 7) = Semaine And .Cells(k, 8) = Articles Then
Sheets("Extraction").Range("A" & lig & ":J" & lig).Value = .Range("A" & k & ":J" & k).Value
lig = lig + 1
End If
Next
End With
End If
Next
End Sub
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

@candido57
Un petit conseil (d'ordre esthétique) en passant
Utilises les balises BBCODE suivantes [CODE] le code de la macro [/CODE]
pour rendre ton message plus agréable à lire
VB: 
Sub Extraction()
Semaine = [B2]
N°_Carte = [F2]
Articles = [H2]
[A7:J65000].ClearContents
lig = 7

If Semaine = "" Then
For Each sh In Worksheets
If Left(sh.Name, 1) = "B" Then
With Sheets(sh.Name)
For k = 5 To .[A65000].End(3).Row
If .Cells(k, 3) = N°_Carte And .Cells(k, 8) = Articles Then
Sheets("Extraction").Range("A" & lig & ":J" & lig).Value = .Range("A" & k & ":J" & k).Value
lig = lig + 1
End If
Next
End With
End If
Next
Exit Sub
End If

If N°_Carte = "" Then
For Each sh In Worksheets
If Left(sh.Name, 1) = "B" Then
With Sheets(sh.Name)
For k = 5 To .[A65000].End(3).Row
If .Cells(k, 7) = Semaine And .Cells(k, 8) = Articles Then
Sheets("Extraction").Range("A" & lig & ":J" & lig).Value = .Range("A" & k & ":J" & k).Value
lig = lig + 1
End If
Next
End With
End If
Next
Exit Sub
End If

If Articles = "" Then
For Each sh In Worksheets
If Left(sh.Name, 1) = "B" Then
With Sheets(sh.Name)
For k = 5 To .[A65000].End(3).Row
If .Cells(k, 3) = N°_Carte And .Cells(k, 7) = Semaine Then
Sheets("Extraction").Range("A" & lig & ":J" & lig).Value = .Range("A" & k & ":J" & k).Value
lig = lig + 1
End If
Next
End With
End If
Next
Exit Sub
End If

'tous
For Each sh In Worksheets
If Left(sh.Name, 1) = "B" Then
With Sheets(sh.Name)
For k = 5 To .[A65000].End(3).Row
If .Cells(k, 3) = N°_Carte And .Cells(k, 7) = Semaine And .Cells(k, 8) = Articles Then
Sheets("Extraction").Range("A" & lig & ":J" & lig).Value = .Range("A" & k & ":J" & k).Value
lig = lig + 1
End If
Next
End With
End If
Next
End Sub
 
Vote positif 0 Vote négatif
C

candido57

XLDnaute Occasionnel
Staple1600 à dit:
Re

@candido57
Un petit conseil (d'ordre esthétique) en passant
Utilises les balises BBCODE suivantes [CODE] le code de la macro [/CODE]
pour rendre ton message plus agréable à lire
VB: 
Sub Extraction()
Semaine = [B2]
N°_Carte = [F2]
Articles = [H2]
[A7:J65000].ClearContents
lig = 7

If Semaine = "" Then
For Each sh In Worksheets
If Left(sh.Name, 1) = "B" Then
With Sheets(sh.Name)
For k = 5 To .[A65000].End(3).Row
If .Cells(k, 3) = N°_Carte And .Cells(k, 8) = Articles Then
Sheets("Extraction").Range("A" & lig & ":J" & lig).Value = .Range("A" & k & ":J" & k).Value
lig = lig + 1
End If
Next
End With
End If
Next
Exit Sub
End If

If N°_Carte = "" Then
For Each sh In Worksheets
If Left(sh.Name, 1) = "B" Then
With Sheets(sh.Name)
For k = 5 To .[A65000].End(3).Row
If .Cells(k, 7) = Semaine And .Cells(k, 8) = Articles Then
Sheets("Extraction").Range("A" & lig & ":J" & lig).Value = .Range("A" & k & ":J" & k).Value
lig = lig + 1
End If
Next
End With
End If
Next
Exit Sub
End If

If Articles = "" Then
For Each sh In Worksheets
If Left(sh.Name, 1) = "B" Then
With Sheets(sh.Name)
For k = 5 To .[A65000].End(3).Row
If .Cells(k, 3) = N°_Carte And .Cells(k, 7) = Semaine Then
Sheets("Extraction").Range("A" & lig & ":J" & lig).Value = .Range("A" & k & ":J" & k).Value
lig = lig + 1
End If
Next
End With
End If
Next
Exit Sub
End If

'tous
For Each sh In Worksheets
If Left(sh.Name, 1) = "B" Then
With Sheets(sh.Name)
For k = 5 To .[A65000].End(3).Row
If .Cells(k, 3) = N°_Carte And .Cells(k, 7) = Semaine And .Cells(k, 8) = Articles Then
Sheets("Extraction").Range("A" & lig & ":J" & lig).Value = .Range("A" & k & ":J" & k).Value
lig = lig + 1
End If
Next
End With
End If
Next
End Sub
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re

@candido57
Oui mais je préfère faire plus simple
Voilà comment je ferais
La macro
VB: 
Sub Extraction_Staple()
Sheets("Base").Range("A2:J40").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Range("Criteria"), _
CopyToRange:=Range("Extract"), Unique:=False
End Sub
Avec un ajout sur la feuille Extraction
En L7: =F2
En M7: =H2

RESULTAT ci-dessous
Extraction.PNG
NB: test OK sur Office 365

PS: Si cela gêne, on mettre la couleur de police en blanc les cellules L7 et M7.
Pour qu'on ne voit pas les critères du filtre avancé.
 
Vote positif 0 Vote négatif
C

candido57

XLDnaute Occasionnel
Staple1600 à dit:
Re

@candido57
Oui mais je préfère faire plus simple
Voilà comment je ferais
La macro
VB: 
Sub Extraction_Staple()
Sheets("Base").Range("A2:J40").AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=Range("Criteria"), _
CopyToRange:=Range("Extract"), Unique:=False
End Sub
Avec un ajout sur la feuille Extraction
En L7: =F2
En M7: =H2

RESULTAT ci-dessous
Regarde la pièce jointe 1170489
NB: test OK sur Office 365

PS: Si cela gêne, on mettre la couleur de police en blanc les cellules L7 et M7.
Pour qu'on ne voit pas les critères du filtre avancé.
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
RE

@candido57
Avec cette version dans laquelle j'ai ajouté des commentaires, la mise en oeuvre devrait être plus simple.
;)
VB: 
Sub Extraction_Staple_BIS()
Dim CRITERES As Range, RECOPIE As Range
'ici on définit la plage des critères du filtre
Set CRITERES = Sheets("Extraction").Range("L6:M7")
'ici on définit où la recopie du filtre se fera
Set RECOPIE = Sheets("Extraction").Range("A6:J6")
'ici on applique le filtre avancé
Sheets("Base").Range("A2:J40").AdvancedFilter _
    Action:=xlFilterCopy, _
    CriteriaRange:=CRITERES, _
    CopyToRange:=RECOPIE, Unique:=False
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

T
  • Résolu(e)
Formule pour extraire des valeurs uniques
Réponses
5
Affichages
182
mapomme
mapomme
A
  • Résolu(e)
XL 2016 Copier Coller données avec VBA dernière cellules vide
Réponses
13
Affichages
262
Anto35200
A
D
  • Question
XL 2016 macro pour copier coller des cellules d'une feuille dans une autre feuille avec condition
Réponses
2
Affichages
254
Phil69970
Phil69970
A
  • Question
Microsoft 365 Compteur de jours consécutifs travaillés
Réponses
5
Affichages
350
Ay-Ricko
A
S
  • Question
Microsoft 365 Pulbipostage Excel→Word : cases à cocher
Réponses
1
Affichages
122
Staple1600
Staple1600
S
  • Résolu(e)
XL 2016 Besoin d'aide pour un code d'extraction
Réponses
14
Affichages
274
Phil69970
Phil69970
B
  • Question
Microsoft 365 Regroupement de cellule avec somme
Réponses
8
Affichages
315
bandimalou
B
C
  • Question
XL 2013 Extraction et saisi donné dans texbox
Réponses
7
Affichages
344
candido57
C
T
  • Question
Microsoft 365 Query : "un tableau ne peut pas en chevaucher un autre"
Réponses
3
Affichages
182
thenesol
T
chris6999
  • Question
Microsoft 365 MACRO VBA - Extraire des listes à partir d'une boucle
Réponses
5
Affichages
206
chris6999
chris6999

Membres actuellement en ligne

6 membres et 44 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 215
Messages
2 086 329
Membres
103 183
dernier inscrit
karelhu35