Macro vba

h2so4

01/06/2007 à 22:44

bonsoir,

Quel est le role du critère de sélection ?
peux-tu m'indiquer quel résultat tu attends dans feuille 2 ("coll") avec le
critère de sélection V510 ?

voici une proposition, mais comme je suis pas sur d'avoir compris, feuille1
= creation et feuille 2 = coll

sub macro()
i=2
while worksheets("coll").cells(i,1)<>""
if worksheets("coll").cells(i,1)=worksheets("creation").cells(3,1) then
worksheets("creation").cells(14+j,1)=worksheets("coll").cells(i,3)
j=j+1
end if
i=i+1
wend

--

h2so4
play triogical at http://www.triogical.com
"Romi" wrote in message
news:

FFO

01/06/2007 à 23:12

Salut Romi

En reprenant ton code avec les corrections nécessaire celà donne :

LeNom = Sheets("CREATION").Range("A3")
Sheets("CREATION").Select
Range("A14").Select
Sheets("Coll").Select
Range("A65535").End(xlUp).Select
Do While ActiveCell.Address <> Range("A1").Address
If ActiveCell = LeNom Then
Code = ActiveCell.Offset(0, 2).Value
Sheets("CREATION").Select
ActiveCell.Value = Code
ActiveCell.Offset(1, 0).Select
Sheets("Coll").Select
End If
ActiveCell.Offset(-1, 0).Select
Loop
If ActiveCell = LeNom Then
Code = ActiveCell.Offset(0, 2).Value
Sheets("CREATION").Select
ActiveCell = Code
End If
Range("b1").Select

Cette solution en l'état fonctionne mais on pourrait faire plus simple
J'ai préféré gardé ta trame

Espérant que celà te convienne
Dis moi !!!!

LSteph

01/06/2007 à 23:26

Bonsoir,

Sub azA3()
Dim myR As Range, c As Range, i As Long
i = 14
With Sheets("Coll")
Set myR = .Range("a1", .[a65536].End(xlUp).Address)
End With
For Each c In myR.Cells
With Sheets("CREATION")
If c = .[a3] Then
.Cells(i, 1) = c.Offset(0, 2)
i = i + 1
End If
End With
Next
End Sub

'lSteph

Romi

02/06/2007 à 17:17

Tout d'abord merci pour votre aide
J'ai essayé la proposition de FFO mais j'ai un message à la fin de
l'exécution de la macro :
"Erreur Exécution '1004'
Erreur definie par l'application ou par l'objet"

En cliquant sur débogage : la ligne "ActiveCell.Offset(-1,0).Select" est
surlignée, cepedant toutes les valeurs sont affichées dans la feuille
"CREATION" et serait-il possible de les avoir dans l'ordre croissant.
Mais je suis preneur pour plus simple
Bonne journée
Romi

Hervé

02/06/2007 à 18:04

Bonjour Romi,
Je ne suis pas bien sûr d'avoir tous compris mais voyons, tu veux récupérer
sur la feuille "Coll" à partir de la cellule A14 une valeur située dans la
feuille "CREATION" en colonne C en fonction d'un critère entré en A3 de la
feuille "Coll" et la recherche doir s'effectuer dans la feuille "CREATION"
en colonne A ? Regarde et teste le code ci-dessous :
Les valeurs retournées sont collées à partir de la cellule A14 (A15, A16,
Ax...) pour que ceci fonctionne, la colonne A doit être vide sous la cellule
A14.
Au fait, évite les Select qui dans ton cas sont inutiles et ralentissent le
code.

Sub Recup()
Dim Fe As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim LeNom As String

'Récupère le critère
LeNom = Worksheets("Coll").[A3]

'défini la plage de recherche
Set Fe = Worksheets("CREATION")
With Fe
Set Plage = .Range(.[a1], .[A65536].End(3))
End With

'cherche la correspondance dans la plage
Set Cel = Plage.Find(LeNom, , xlValues)

'si trouvé, retourne la valeur de la
'colonne C et la colle dans la colonne
'A à partir de la cellule A14 de la feuille
'"Coll" (les colle les unes au dessous des autres)
If Not Cel Is Nothing Then
Set Fe = Worksheets("Coll")
With Fe
If .[A14] = "" Then
.[A14] = Cel.Offset(0, 2)
Else
.[A65536].End(3).Offset(1) = Cel.Offset(0, 2)
End If
End With
End If

Set Cel = Nothing
Set Plage = Nothing
Set Fe = Nothing
End Sub

Hervé.

"Romi" a écrit dans le message de news:

Bonjour Romi,
Je ne suis pas bien sûr d'avoir tous compris mais voyons, tu veux récupérer
sur la feuille "Coll" à partir de la cellule A14 une valeur située dans la
feuille "CREATION" en colonne C en fonction d'un critère entré en A3 de la
feuille "Coll" et la recherche doir s'effectuer dans la feuille "CREATION"
en colonne A ? Regarde et teste le code ci-dessous :
Les valeurs retournées sont collées à partir de la cellule A14 (A15, A16,
Ax...) pour que ceci fonctionne, la colonne A doit être vide sous la cellule
A14.
Au fait, évite les Select qui dans ton cas sont inutiles et ralentissent le
code.

Sub Recup()
Dim Fe As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim LeNom As String

'Récupère le critère
LeNom = Worksheets("Coll").[A3]

'défini la plage de recherche
Set Fe = Worksheets("CREATION")
With Fe
Set Plage = .Range(.[a1], .[A65536].End(3))
End With

'cherche la correspondance dans la plage
Set Cel = Plage.Find(LeNom, , xlValues)

'si trouvé, retourne la valeur de la
'colonne C et la colle dans la colonne
'A à partir de la cellule A14 de la feuille
'"Coll" (les colle les unes au dessous des autres)
If Not Cel Is Nothing Then
Set Fe = Worksheets("Coll")
With Fe
If .[A14] = "" Then
.[A14] = Cel.Offset(0, 2)
Else
.[A65536].End(3).Offset(1) = Cel.Offset(0, 2)
End If
End With
End If

Set Cel = Nothing
Set Plage = Nothing
Set Fe = Nothing
End Sub

Hervé.

"Romi" <nospamromi@wanadoo.fr> a écrit dans le message de news:
uPwdngIpHHA.1776@TK2MSFTNGP05.phx.gbl...

Vous avez filtré cet utilisateur ! Consultez son message

Bonjour Romi,
Je ne suis pas bien sûr d'avoir tous compris mais voyons, tu veux récupérer
sur la feuille "Coll" à partir de la cellule A14 une valeur située dans la
feuille "CREATION" en colonne C en fonction d'un critère entré en A3 de la
feuille "Coll" et la recherche doir s'effectuer dans la feuille "CREATION"
en colonne A ? Regarde et teste le code ci-dessous :
Les valeurs retournées sont collées à partir de la cellule A14 (A15, A16,
Ax...) pour que ceci fonctionne, la colonne A doit être vide sous la cellule
A14.
Au fait, évite les Select qui dans ton cas sont inutiles et ralentissent le
code.

Sub Recup()
Dim Fe As Worksheet
Dim Plage As Range
Dim Cel As Range
Dim LeNom As String

'Récupère le critère
LeNom = Worksheets("Coll").[A3]

'défini la plage de recherche
Set Fe = Worksheets("CREATION")
With Fe
Set Plage = .Range(.[a1], .[A65536].End(3))
End With

'cherche la correspondance dans la plage
Set Cel = Plage.Find(LeNom, , xlValues)

'si trouvé, retourne la valeur de la
'colonne C et la colle dans la colonne
'A à partir de la cellule A14 de la feuille
'"Coll" (les colle les unes au dessous des autres)
If Not Cel Is Nothing Then
Set Fe = Worksheets("Coll")
With Fe
If .[A14] = "" Then
.[A14] = Cel.Offset(0, 2)
Else
.[A65536].End(3).Offset(1) = Cel.Offset(0, 2)
End If
End With
End If

Set Cel = Nothing
Set Plage = Nothing
Set Fe = Nothing
End Sub

Hervé.

"Romi" a écrit dans le message de news:

Romi

03/06/2007 à 09:11

Bonjour,
En complement, ce que je cherche est l'equivalent de la foncion
recherchev soit :
feuille"creation" en a14
=recherchev(a3;coll!a1:c560;3)
Suivant la valeur de A3, il peur y avoir entre 3 et 30 réponses, c'est
donc pour éviter de recopier cette formule et d'avoir les N/A sur la feuille

FFO

03/06/2007 à 10:50

Salut Romi

Je te propose ce code intégrant le tri :

n = 14
Sheets("Coll").Select
For Each c In Worksheets("Coll").Range([A1], [A65535].End(xlUp))
If c = Sheets("CREATION").Range("A3") Then
Sheets("CREATION").Range("A" & n) = c.Offset(0, 2)
n = n + 1
End If
Next
Sheets("CREATION").Select
Range("A14", [A14].End(xlDown)).Select
Selection.Sort Key1:=Range("A14"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:úlse, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Celà te convient-il ???
Dis moi !!!

Romi

03/06/2007 à 20:22

Merci à TOUS pour votre aide
J'ai retenu la 2eme solution de FFO qui me convient parfaitement
Bonne continuation

Macro vba

8 réponses

Veuillez sélectionner un problème