Macro qui renvoie les valeurs de plusieurs cellules dans un nouveau tableau

M

Moonshine

XLDnaute Nouveau
Bonjour tout le monde,
Je suis débutante en VBA (capable de comprendre les macros, mais plus difficilement de les créer) et j'ai un problème pour la création d'une macro assez complexe.
J'ai des données dans un tableau Excel nommé BASE qui comporte de multiples colonnes et je voudrais que, pour chaque ligne :
- Si la cellule F = "..."
- Et si la cellule G = "..."
- Et si la cellule X = "..."
- Et si la cellule Y = "..."
ALORS remplir la colonne A d'une autre feuille Excel nommée EXTRACTION avec la valeur de la cellule A (format texte) de la feuille BASE.

La colonne A de la feuille EXTRACTION sera donc remplie peu à peu à chaque fois que les valeurs de la ligne correspondent aux conditions requises.

Je remercie d'avance tous ceux qui passeront un peu de temps à se pencher sur cette macro!
Bon week end!
 
Trier par date Trier par votes
M

Moonshine

XLDnaute Nouveau
Re : Macro qui renvoie les valeurs de plusieurs cellules dans un nouveau tableau

Bonjour,
Je vous joins mon tableau de données épuré que j'ai nommé BASE dans mon précédent message.
¨
Pour ce cas,
je voudrais que, pour chaque ligne du tableau BASE :
- Si la cellule B = "hygiène"
- Et si la cellule C = "Corps"
- Et si la cellule D = "bonne"
- Et si la cellule E = "dermatologique"
ALORS remplir la colonne A d'une autre feuille Excel nommée EXTRACTION avec la valeur de la cellule A, c'est a dire le code de l'étude (format texte) de la feuille BASE.

La colonne A de la feuille EXTRACTION sera donc remplie peu à peu à chaque fois que les valeurs de la ligne correspondent aux conditions requises.

Merci d'avance, n'hésitez pas à me dire si je ne suis pas très claire!
 

Pièces jointes

  • Export.xlsm
    20.1 KB · Affichages: 176
Vote positif 0 Vote négatif
KenDev

KenDev

XLDnaute Impliqué
Re : Macro qui renvoie les valeurs de plusieurs cellules dans un nouveau tableau

Bonjour Moonshine, Pierre-Jean,

La même chose après avoir vu le fichier et rajouté une boucle à cause des cellules fusionnées en colonne A.

VB: 
Option Explicit

Sub Moon()
Dim w1 As Worksheet, w2 As Worksheet, i&, r&, t%, z&
Set w1 = Worksheets("BASE"): Set w2 = Worksheets("EXTRACTION")
r = w2.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To w1.Cells(Rows.Count, 1).End(xlUp).Row
    t = 0
    If LCase(Trim(w1.Cells(i, 2))) = "hygiène" Then t = t + 1
    If LCase(Trim(w1.Cells(i, 3))) = "corps" Then t = t + 1
    If LCase(Trim(w1.Cells(i, 4))) = "bonne" Then t = t + 1
    If LCase(Trim(w1.Cells(i, 5))) = "dermatologique" Then t = t + 1
    If t = 4 Then
        r = r + 1
        z = 0
        Do Until w1.Cells(i - z, 1) <> ""
            z = z + 1
        Loop
        w2.Cells(r, 1) = w1.Cells(i - z, 1)
    End If
Next i
End Sub

Cordialement

KD
 
Vote positif 0 Vote négatif
M

Moonshine

XLDnaute Nouveau
Re : Macro qui renvoie les valeurs de plusieurs cellules dans un nouveau tableau

Merci KD pour ta réponse. Mais ça ne marche pas, un message d'erreur "l'indice n'appartient pas à la sélection" apparait lors du lancement de la macro.
Pourrais-tu m'expliquer les différentes étapes de la macro en commentaire?
Merci!
 
Vote positif 0 Vote négatif
KenDev

KenDev

XLDnaute Impliqué
Re : Macro qui renvoie les valeurs de plusieurs cellules dans un nouveau tableau

Bonjour Moonshine,

Dans le classeur fourni les feuilles sont nommées Feuil1,2 , 3. Dans ton texte tu parles d'une feuille EXTRACTION. J'ai donc renommé une des feuilles vierges en EXTRACTION et la feuille qui contient le tableau en BASE. Cordialement

KD
 
Vote positif 0 Vote négatif
M

Moonshine

XLDnaute Nouveau
Re : Macro qui renvoie les valeurs de plusieurs cellules dans un nouveau tableau

J'ai du mal m'exprimer en décrivant mon problème... Base est un classeur Excel a une feuille nommée "2008" par exemple, et je veux que les données extraites aillent dans Extraction qui est un autre classeur Excel, sur une feuille nommée "Données Etudes" par exemple.
 
Vote positif 0 Vote négatif
KenDev

KenDev

XLDnaute Impliqué
Re : Macro qui renvoie les valeurs de plusieurs cellules dans un nouveau tableau

Bonjour Monshine,

Ci-joint deux fichiers. Mode d'emploi: ouvrir classeur extraction et lancer la macro.

Cordialement

KD

VB: 
Option Explicit

Sub Moon()
Dim Wb1 As Workbook, Wb2 As Workbook, Ws1 As Worksheet, Ws2 As Worksheet
Dim s$, r&, i&, t%, z&

'déclaration objets du classeur Extraction
Set Wb1 = Workbooks("Extraction.xls"): Set Ws1 = Wb1.Worksheets("Données Etudes")

'classeur Base, ouverture et déclarations des objets
s = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")
If s = "Faux" Then Exit Sub 'si Annuler, sortir
Set Wb2 = Workbooks.Open(s)
s = Application.InputBox(prompt:="Nom de la feuille concernée ?", Default:=Wb2.Worksheets(1).Name)
If s = "Faux" Then 'si Annuler
    Wb2.Close 'fermer base
    Exit Sub
End If
Set Ws2 = Wb2.Worksheets(s)

'traitement
r = Ws1.Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne écrite dans Données Etudes
For i = 2 To Ws2.Cells(Rows.Count, 1).End(xlUp).Row 'pour chaque ligne de la feuille du classeur base
    t = 0 'nombre de conditions remplies
    'tests conditions
    If LCase(Trim(Ws2.Cells(i, 2))) = "hygiène" Then t = t + 1
    If LCase(Trim(Ws2.Cells(i, 3))) = "corps" Then t = t + 1
    If LCase(Trim(Ws2.Cells(i, 4))) = "bonne" Then t = t + 1
    If LCase(Trim(Ws2.Cells(i, 5))) = "dermatologique" Then t = t + 1
    If t = 4 Then 'si toutes les conditions sont remplies
        r = r + 1 'écriture sera à la ligne suivante
        'cas de cellules fusionnées
        z = 0
        Do Until Ws2.Cells(i - z, 1) <> ""
            z = z + 1
        Loop
        'écriture
        Ws1.Cells(r, 1) = Ws2.Cells(i - z, 1)
    End If
Next i
Wb2.Close 'fermer base
End Sub
 

Pièces jointes

  • Extraction.xls
    35.5 KB · Affichages: 107
  • Base.xls
    58.5 KB · Affichages: 115
  • Extraction.xls
    35.5 KB · Affichages: 112
  • Base.xls
    58.5 KB · Affichages: 124
  • Extraction.xls
    35.5 KB · Affichages: 112
  • Base.xls
    58.5 KB · Affichages: 118
Vote positif 0 Vote négatif
Pierrot93

Pierrot93

XLDnaute Barbatruc
Re : Macro qui renvoie les valeurs de plusieurs cellules dans un nouveau tableau

Bonjour,

Moonshine à dit:
La macro ne marche pas, Excel m'ouvre la fenêtre "Ouvrir"... Que dois-je faire?
Cliquez pour agrandir...

pas tout suivi, mais cela parait normal, il y a cette instruction en début de procédure :
Code: 
s = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*")

c'est elle qui ouvre la fenêtre en question...

bonne journée
@+
 
Vote positif 0 Vote négatif
KenDev

KenDev

XLDnaute Impliqué
Re : Macro qui renvoie les valeurs de plusieurs cellules dans un nouveau tableau

Bonjour Moonshine, Pierrot,

La macro marche très bien selon ce que je lui ai dit de faire. Quand tu lances la macro, la fenêtre te permet d'ouvrir manuellement le classeur Base ou se trouvent les données à extraire.
J'ai fait ce choix :
1_Au cas ou l'extraction au cours du temps se fasse sur des classeurs différent pour ne pas à avoir à modifier le code à chaque fois
2_car tu ne donnes pas le chemin du classeur Base, je ne pouvais donc pas le deviner
Ensuite la macro va te proposer comme nom de feuille où réaliser l'extraction la 1ère trouvée, si c'est la bonne juste faire ok sinon mettre le nom de la bonne feuille.

Cordialement

KD
 
Vote positif 0 Vote négatif
M

Moonshine

XLDnaute Nouveau
Re : Macro qui renvoie les valeurs de plusieurs cellules dans un nouveau tableau

KD,
Je te remercie d'avoir pris en compte ce cas, mais comme mes fichiers Extraction et Base seront ouvert conjointement, je pensais pouvoir faire :
Option Explicit

Sub Moon()
Dim Wb1 As Workbook, Wb2 As Workbook, Ws1 As Worksheet, Ws2 As Worksheet
Dim s$, r&, i&, t%, z&

'déclaration objets du classeur Extraction
Set Wb1 = Workbooks("Extraction.xls"): Set Ws1 = Wb1.Worksheets("Données Etudes")

'classeur Base,déclarations des objets
Set Wb2 = Workbooks("T:\travail\2011\Indicateurs Qualité\Base.xls"): Set Ws2 = Wb2.Worksheets("2008")


'traitement
r = Ws1.Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne écrite dans Données Etudes
For i = 2 To Ws2.Cells(Rows.Count, 1).End(xlUp).Row 'pour chaque ligne de la feuille du classeur base
t = 0 'nombre de conditions remplies
'tests conditions
If LCase(Trim(Ws2.Cells(i, 2))) = "hygiène" Then t = t + 1
If LCase(Trim(Ws2.Cells(i, 3))) = "cheveux" Then t = t + 1
If LCase(Trim(Ws2.Cells(i, 4))) = "moyenne" Then t = t + 1
If LCase(Trim(Ws2.Cells(i, 5))) = "dermatologique" Then t = t + 1
If t = 4 Then 'si toutes les conditions sont remplies
r = r + 1 'écriture sera à la ligne suivante
'cas de cellules fusionnées
z = 0
Do Until Ws2.Cells(i - z, 1) <> ""
z = z + 1
Loop
'écriture
Ws1.Cells(r, 1) = Ws2.Cells(i - z, 1)
End If
Next i

End Sub
Cliquez pour agrandir...

J'ai peut être effacé un truc essentiel car ça n'a pas l'air de marcher...
Désolée de t'embêter KD!
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
XL 2021 Rechercher dans une matrice le texte d'une cellule et copier les 10 lignes situées en dessous de ce texte retrouvé
Réponses
2
Affichages
148
JHA
J
JBOBO
  • Question
XL 2019 sommer les valeurs d'un tableau dans un autre selon critere
Réponses
2
Affichages
173
JBOBO
JBOBO
M
  • Question
XL 2010 Comment alimenter automatiquement des cellules à partir d'une ligne sélectionnée dans un tableau?
Réponses
13
Affichages
562
ManuXZ
M
A
  • Question
Microsoft 365 valeurs de cellules
Réponses
7
Affichages
234
auloin
A
T
  • Question
Microsoft 365 Query : "un tableau ne peut pas en chevaucher un autre"
Réponses
3
Affichages
187
thenesol
T
C
  • Question
Microsoft 365 Mise en forme conditionnelle recherche V par feuille
Réponses
2
Affichages
111
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
256
Phil69970
Phil69970
C
  • Résolu(e)
Microsoft 365 recherche valeur dans plusieurs onglets plusieurs critères
Réponses
2
Affichages
119
c.azzopardi@free.fr
C
M
  • Question
XL 2019 Images dans plusieurs cellules à partir de plusieurs URL
2
Réponses
15
Affichages
327
patricktoulon
patricktoulon
C
  • Question
XL 2016 Faire un tableau de nombres uniques puis associer des images aux cellules
Réponses
4
Affichages
244
DJunqueira
D

Membres actuellement en ligne

10 membres et 86 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 222
Messages
2 086 395
Membres
103 200
dernier inscrit
pascalgip