code VBA pour si(nbval=4....

[jaouad]

Bonjours mes chers amis
etant debutant en VBA j'aimerai bien que vous m'aidiez sur ce petit souci:
dans une feuil1 si nbval(A4:A7)= 4 ====) inscrire la valeur de la cellule A1 dans la premiere cellule vide du rang(C8:C167) de la feuil2 ( idem nbval(B4:B7)...A2 ; nbval(C4:C7)...A3 et ainsi de suite ).
merci d'avance de votre precieuse aide

 

[david84]

Re : code VBA pour si(nbval=4....

Bonsoir,
tu nous dis A1, A2 et A3: n'est-ce pas plutôt A1, B1 et C1 ?
A+

 

[laurent950]

Re : code VBA pour si(nbval=4....

Bonsoir jaouad et aussi david84.

je pense avoir compris la demande de jaouad.

Voici le code (j'ai fait ce que j'ai pu)

code :

Sub test()

' Mise en mémoire de la feuil2 en variable Objet (F1 = Feuil2)
Set F1 = ThisWorkbook.Worksheets("Feuil2")

' Initialisation pour départ de la feuil2
F1.Cells(7, 3) = " "
Fin = F1.Range("c65500").End(xlUp).Row

' Boucle for
For i = 1 To 8
F1.Cells(Fin + i, 3) = Cells(1, i)
Next i

' Remise à Zéro
F1.Cells(7, 3) = ""
Set F1 = Nothing ' Dechargement de la variable objet

End Sub

Vous faite en A1 de la feuil1 (La formule pour connaitre le NbVal) il n'y a pas beoin de macro pour cela enfin je pense la macro rapratrie les information en feuil2

Laurent

 

[jaouad]

Re : code VBA pour si(nbval=4....

c'est vrai david je voullais dire A1 , B1, C1, etc...

merci laurent pour votre interet et reponse mais il ne faut inscrire que les valeurs des cellules (A1 , B1 , C 1,etc... ) qui repondent a la condition nbval= 4

pour etre plus explicite , j'avais deja met le code suivant pour designer: si toute cellule de la ligne 8 de la feuil1 est remplie inscrire la valeur correspondante (ligne 1 ) dans la premiere cellule vide du rang(C8:C167) de la feuil2, et ca marche tres bien :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Range
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A8:IU8")) Is Nothing Then
With Sheets("feuil2")
Set x = .Range("C8:C167").Find("", .Range("C167"), xlValues, , 1, 1, 0)
If Not x Is Nothing Then x.Value = Target.Value
End With
End If
end sub

pour le cas actuel il faut par exemple que A4,A5,A6,A7 soientt remplies pour inscrire la valeur correspondante (en ligne 1) dans la premiere cellule vide du rang(C8:C167) de la feuil2

dans ce cas quels changements dois je mettre dans le code ?
merci infiniment mes chers amis

 

[jaouad]

Re : code VBA pour si(nbval=4....

toujours pas de reponses les amis ?
svp j'en ai tellement besoin.

 

[Softmama]

Re : code VBA pour si(nbval=4....

Bonjour jaouad,

Je crains de pas avoir compris grand chose... J'ai quand même fait un quelque chose. Fais-moi savoir ce qui ne va pas.

Private Sub Worksheet_Change(ByVal T As Range)
'pas sur d'avoir compris le problème :p
If T.Count > 1 Then Exit Sub
Dim c As Range, d As Range
  Set d = Feuil2.Range("C8")
  d.Resize(1000).ClearContents
  For Each c In Feuil1.Range("A1").CurrentRegion
    If Application.CountA(Range(c.Offset(3, 0), c.Offset(1000, 0))) = 4 Then c.Copy d: Set d = d.Offset(1, 0)
  Next c
End Sub

 

[jaouad]

Re : code VBA pour si(nbval=4....

c super extra bon mais quoi faire pour n'inscrire que la valeur sans mise en forme (couleur de la cellule d'origine) ni ordre

 

[Pierrot93]

Re : code VBA pour si(nbval=4....

Bonjour,

c super extra bon mais quoi faire pour n'inscrire que la valeur sans mise en forme (couleur de la cellule d'origine) ni ordre

modifie cette partie du code comme suit :

If Application.CountA(Range(c.Offset(3, 0), c.Offset(1000, 0))) = 4 Then d.Value = c.value: Set d = d.Offset(1, 0)

bonne journée
@+

 

[jaouad]

Re : code VBA pour si(nbval=4....

merci pierrot93 ca marche tres bien mais lorsque j'ai essayé d'adapter le code avec d'autres cellules et feuils ca provoque une erreur dont j'ignore la reference, j'ai effectué les operations suivantes :
remplacer : Set d = Feuil2.Range("C8") par Set d = Meilleur_Bonus.Range("D338")
For Each c In Feuil1.Range("A1").CurrentRegion par For Each c In Saisie_Personnels.Range("E3").CurrentRegion
Range(c.Offset(3, 0), c.Offset(1000, 0)) par Range(c.Offset(17, 4), c.Offset(20, 4)) (pour ne prendre en consideration que les lignes 18-19-20-21)
voila je sais pas qu'est ce que j'ai negligé dans ces changements et je compte sur vos aides mes chers amis

 

[Pierrot93]

Re : code VBA pour si(nbval=4....

Bonjour,

A quoi correspond " Meilleur_Bonus", ce devrait être un "codeName" de feuille ou une variable mais en aucun cas le nom de la feuille... sans pluis de détails difficile d'en dire plus...

bonne journée
@+

 

[jaouad]

Re : code VBA pour si(nbval=4....

pardon de ne pas etre si claire dans ma description cher pierrot, Meilleur Bonus et Saisie Personnels sont les noms de feuils que je traite, je joins le fichier pour etre bcp plus explicite
merci d'avance pour votre precieuse aide

 

[jaouad]

Re : code VBA pour si(nbval=4....

je crois etre troop abusif dans le traitement de ce sujet
pardon mes chers amis

 

[Pierrot93]

Re : code VBA pour si(nbval=4....

Bonjour,

si "Meilleur_Bonus" est un nom de feuille, remplacer :

Set d = Meilleur_Bonus.Range("D338")

par :

Set d = Sheets("Meilleur_Bonus").Range("D338")

bonne journée
@+

 

[jaouad]

Re : code VBA pour si(nbval=4....

salut cher pierrot
j'ai essayé ca mais ca renvoi toujours à un probleme
merci intensement de votre aide
cordialement jaouad

 

[Softmama]

Re : code VBA pour si(nbval=4....

Bonjour jaouad, Pierrot93

Ton code corrigé (en vert les explications):

Private Sub Worksheet_Change(ByVal T As Range)
If T.Count > 1 Then Exit Sub
Dim c As Range, d As Range
Set d = Sheets("Meilleur Bonus").Range("D338") 'y a pas de _, mais un espace dans le nom de la feuille
  d.Resize(497).ClearContents
  For Each c In Range("E3").CurrentRegion
    If Application.CountA(Range(c.Offset(15, 0), c.Offset(18, 0))) = 4 Then c.Copy:  d.PasteSpecial Paste:=xlPasteValues: Set d = d.Offset(1, 0) 'décalage de 15 à 18 lignes sous la ligne 3 pas 17 à 20 !
  Next c
End Sub

++