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

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!
 

Moonshine

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

Autre chose que je n'ai pas réussi à comprendre (par manque d'expérience) dans ta macro KD, c'est comment changer la position de la colonne qui sera remplie dans "Données Etude" du classeur "Extraction".
 

Moonshine

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

Autre chose que je n'ai pas réussi à comprendre dans ta macro (par manque d'expérience), c'est l'endroit où tu définit la colonne A comme colonne à remplir dans "Extraction" --> "Données Etudes".
 

KenDev

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

Bonjour Moonshine,

Si les 2 classeurs sont ouverts c'est plus simple, ton adaptation était bonne, c'est juste que Set Wb2 = Workbooks("Base.xls") suffisait, pas besoin d'indiquer un chemin pour un classeur ouvert.

Pour la colonne j'ai ajouté les variables c1 et c2, à adapter éventuellement, en début de macro. c1 pour la colonne d'écriture, c2 colonne originelle du 'code étude'.

Evites dans tes messages les "ça marche pas" qui ne donnent aucun renseignements. Généralement une macro plante avec un message et s'arrête sur une ligne; ce serait bien de passer ces informations. Si la macro ne 'marche pas' sans planter alors c'est bien de décrire ce qu'elle a fait ou ce qu'elle n'a pas fait.

Cordialement

KD

VB:
Option Explicit

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

c1 = 1 'n° de la colonne à remplir dans Extraction
c2 = 1 'n° de la colonne 'code étude' dans Base

'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("Base.xls"): Set Ws2 = Wb2.Worksheets("2008")


'traitement
r = Ws1.Cells(Rows.Count, c1).End(xlUp).Row 'dernière ligne écrite dans Données Etudes
For i = 2 To Ws2.Cells(Rows.Count, c2).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, c2 + 1))) = "hygiène" Then t = t + 1
If LCase(Trim(Ws2.Cells(i, c2 + 2))) = "cheveux" Then t = t + 1
If LCase(Trim(Ws2.Cells(i, c2 + 3))) = "moyenne" Then t = t + 1
If LCase(Trim(Ws2.Cells(i, c2 + 4))) = "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, c2) <> ""
z = z + 1
Loop
'écriture
Ws1.Cells(r, c1) = Ws2.Cells(i - z, c2)
End If
Next i

End Sub
 
Dernière édition:

Moonshine

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

Désolée en fait si je n'ai pas mis ce qui ne marchait pas dans mon dernier message c'est qu'il n'y avait aucun message d'erreur, juste que les valeurs ne changeaient pas quand je fais varier une des quatre conditions.Je viens d'essayer ta macro, avec les deux classeurs ouverts, en changeant une des quatre conditions et en mettant c1=2, car j'ai cru que si les valeurs ne changeaient pas c'était qu'il fallait rajouter une ligne pour vider les cellules dans extraction avant. Mais en fait les valeurs ne sont pas renvoyées dans la colonne 2, rien ne se passe nno plus, pas de message d'erreur. As-tu testé la macro sur ton pc en changeant les conditions et elle marchait? si oui je ne sais pas d'ou ça peut venir...
 

KenDev

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

Bonjour Moonshine,

Je ne comprends pas par quel raisonnement tu arrives à écrire c2=c1, as tu lu et dans le message et dans le code, ce que sont ces deux variables ?
J'ai bien sûr testé la macro qui marche. Tel quelle est codée on obtient en colonne 1 :
EF215
EF251
EF263
En changeant la 1ère condition If LCase(Trim(Ws2.Cells(i, c2 + 1))) = "coiffage" Then t = t + 1 et la ligne c1=2 on obtient en colonne 2 :
EF026
EF184
EF228
Les intitulés sont à écrire en minuscule dans la macro.
Cordialement
KD
 

Moonshine

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

Merci KD pour ta réponse.
J'ai evidemment lu ce que tu avais marqué en commentaire de macro, et je n'ai pas mis c1 = c2 mais c1 = 2 (cf mon message précédent).

Comme il y a visiblement un problème dans les manipulations que j'ai pu faire, je vais essayer de t'expliquer.
J'ai créé sur la feuille "Données Etude" du classeur "Extraction", un bouton qui déclenche la macro "moon2".
Ma macro "moon2" est :
Option Explicit

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

c1 = 2 'n° de la colonne à remplir dans Extraction
c2 = 1 'n° de la colonne 'code étude' dans Base

'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("Base.xls"): Set Ws2 = Wb2.Worksheets("2008")


'traitement
r = Ws1.Cells(Rows.Count, c1).End(xlUp).Row 'dernière ligne écrite dans Données Etudes
For i = 2 To Ws2.Cells(Rows.Count, c2).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, c2 + 1))) = "hygiène" Then t = t + 1
If LCase(Trim(Ws2.Cells(i, c2 + 2))) = "cheveux" Then t = t + 1
If LCase(Trim(Ws2.Cells(i, c2 + 3))) = "mauvaise" Then t = t + 1
If LCase(Trim(Ws2.Cells(i, c2 + 4))) = "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, c2) <> ""
z = z + 1
Loop
'écriture
Ws1.Cells(r, c1) = Ws2.Cells(i - z, c2)
End If
Next i

End Sub

Auncune valeur ne s'insère en colonne 2, aucun message d'erreur lors du déclenchement de la macro par clic sur mon bouton.

Je ne comprend pas comment, avec la même macro et les mêmes fichiers cela peut marcher sur ton pc et pas sur le mien, c'est vraiment étrange.
Ai-je pu oublier d'activer quelques chose d'essentiel (pas les macros en tout cas, elles sont activées dans ma feuille Extraction)?
 

KenDev

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

Bonjour Moonshine,

Dans le tableau fourni il n'y a aucune ligne correspondant à hygiène-cheveux-mauvaise-dermatologique. Fais déjà un test avec des conditions dont tu es sure qu'il existe au moins une ligne.
Cordialement

KD
 

Moonshine

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

ou la oui pardon! c'est donc pour ça que ça ne marchait pas! C'est bon, ça marche bien, par contre j'ai passé la macro dans le vba de ma feuille et non pas en module car je ne comprenais pas ce que c'était. Et je vais faire un clearcontents pour vider la colonne si mon tableau Base est actualisé. Je devrais m'en sortir je pense.

Merci beaucoup pour ton aide!

Cordialement,
Moonshine
 

Moonshine

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

Kendev, encore une question concernant la macro que tu m'as donné :
Option Explicit

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

c1 = 2 'n° de la colonne à remplir dans Extraction
c2 = 1 'n° de la colonne 'code étude' dans Base

'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("Base.xls"): Set Ws2 = Wb2.Worksheets("2008")


'traitement
r = Ws1.Cells(Rows.Count, c1).End(xlUp).Row 'dernière ligne écrite dans Données Etudes
For i = 2 To Ws2.Cells(Rows.Count, c2).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, c2 + 1))) = "hygiène" Then t = t + 1
If LCase(Trim(Ws2.Cells(i, c2 + 2))) = "cheveux" Then t = t + 1
If LCase(Trim(Ws2.Cells(i, c2 + 3))) = "mauvaise" Then t = t + 1
If LCase(Trim(Ws2.Cells(i, c2 + 4))) = "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, c2) <> ""
z = z + 1
Loop
'écriture
Ws1.Cells(r, c1) = Ws2.Cells(i - z, c2)
End If
Next i

End Sub

Comment faire pour faire démarrer l'écriture dans la feuille Données Etudes à une certaine ligne (par exemple ligne 7). J'ai essayé de définir r=7, sans succès...En fait je ne vois aucune ligne ou tu as dit variable = 2, donc je ne sais pas trop ou modifier.

Merci d'avance pour ta réponse!

Cordialement,
 

KenDev

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

Bonjour Moonshine,

La ligne
Code:
r = Ws1.Cells(Rows.Count, c1).End(xlUp).Row
indique la dernière ligne écrite pour la colonne d'import. Si tu as quelque chose d'écrit à la ligne 6 l'importation commencera bien à la ligne 7. Si tu souhaites écrire dans tous les cas à partir de la ligne 7 alors il faut la remplacer par
Code:
r=6
. Cordialement

KD
 

Discussions similaires

Réponses
7
Affichages
232

Statistiques des forums

Discussions
312 215
Messages
2 086 324
Membres
103 179
dernier inscrit
BERSEB50