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

A
  • Résolu(e)
Microsoft 365 Copier lien fichier avec VBA
Réponses
1
Affichages
250
vgendron
vgendron
Moi69
  • Résolu(e)
Power Query extraction de donnees particulieres
Réponses
4
Affichages
373
Moi69
Moi69
R
  • Résolu(e)
XL 2021 Valeur unique sur plusieurs colonnes
Réponses
6
Affichages
378
Gégé-45550
Gégé-45550
T
  • Résolu(e)
Formule pour extraire des valeurs uniques
Réponses
5
Affichages
484
mapomme
mapomme
L
  • Question
Microsoft 365 power query help!!!
Réponses
5
Affichages
207
mromain
mromain
H
  • Résolu(e)
XL 2016 Remplacer la formule si.conditions
Réponses
2
Affichages
66
hutch57
H
A
  • Résolu(e)
XL 2016 Copier Coller données avec VBA dernière cellules vide
Réponses
13
Affichages
627
Anto35200
A
P
  • Question
XL 2010 Création d'un carnet de marée
Réponses
9
Affichages
762
JHA
J
P
  • Question
Microsoft 365 Excel - Mettre une date dans une autre cellule en fonction de....
Réponses
8
Affichages
513
JHA
J
D
  • Question
XL 2016 macro pour copier coller des cellules d'une feuille dans une autre feuille avec condition
Réponses
2
Affichages
406
Phil69970
Phil69970

Membres actuellement en ligne

2 membres et 49 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
314 628
Messages
2 111 337
Membres
111 105
dernier inscrit
Joffrette