XL 2013 Extraction

candido57 · 19 Mai 2023

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.

Staple1600 · 19 Mai 2023

Bonjour

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

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

candido57 · 19 Mai 2023

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 .

candido57 · 19 Mai 2023

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

Staple1600 · 19 Mai 2023

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

candido57 · 19 Mai 2023

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

candido57 · 19 Mai 2023

ça ne change rien !!!!
Je ne connais pas , je suis très limité en macro, c'est pour ça que je demande de l'aide

Staple1600 · 19 Mai 2023

Re,

@candido57
Euh ? Comment dire
Ca change seulement cela !

Staple à dit:
pour rendre ton message plus agréable à lire

Et comme précisé en début de message : Un petit conseil (d'ordre esthétique) en passant

candido57 · 19 Mai 2023

as tu regardé ma macro pour m'aider

Staple1600 · 19 Mai 2023

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

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é.

candido57 · 19 Mai 2023

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é.

candido57 · 19 Mai 2023

Je dois copie ta macro et la coller ??? pourrais tu joindre mon fichier avec les modifs
Merci

Staple1600 · 19 Mai 2023

Re

Tu copies la macro dans un module et tu fais les ajouts expliqués dans le message#10
Puis tu testes.

Si difficultés rencontrées pour remise en oeuvre, reviens dans le fil.
J'apporterais de nouvelles précisions.

Staple1600 · 19 Mai 2023

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

candido57 · 19 Mai 2023

est ce que je dois effacer toutes ma macro avant de coller la tienne? ou je la rajouter.
J'ai rajouté les critères en L7 et M7 mais ça ne fonctionne pas

XL 2013 Extraction

candido57

XLDnaute Occasionnel

Pièces jointes

Staple1600

XLDnaute Barbatruc

XL 2013 - Extraction et saisi donné dans texbox

candido57

XLDnaute Occasionnel

candido57

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

candido57

XLDnaute Occasionnel

candido57

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

candido57

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

candido57

XLDnaute Occasionnel

candido57

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

candido57

XLDnaute Occasionnel

Discussions similaires

XL 2013 Extraction

XLDnaute Occasionnel

Pièces jointes

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

Discussions similaires

Privacy & Transparency

Privacy & Transparency