Sujet Précédent Sujet Suivant

Piste sur écriture d'une macro !

Fermé
Edaine Messages postés 62 Date d'inscription mercredi 8 juin 2011 Statut Membre Dernière intervention 23 avril 2012 - 5 juil. 2011 à 16:21
Edaine Messages postés 62 Date d'inscription mercredi 8 juin 2011 Statut Membre Dernière intervention 23 avril 2012 - 6 juil. 2011 à 10:48
Bonjour,

J'ai 2 feuilles,
FeDo et FeT, que j'ai défini dans mon code,

Dans FeT, j'ai un tableau en B10:K29,

J'aimerai reporter des valeurs dans ce tableau à partir des colonnes T,U,V de FeDo,

En faite,

Si en T de FeDo, j'ai un chiffre supérieur à 0, alors j'inscris en B11 de FeT, la valeur de la cellule A qui se trouve sur la même ligne que le chiffre supérieur à 0.
Pareil pour U mais cette fois en F11 et V en I11,

Le problème c'est que j'aimerai qu'il passe automatiquement à la ligne si il y a déjà une valeur inscrite sur la FeT



J'étais partie sur un code avec For Next .. mais je n'arrive à .. rien :/

J'ai un code qui pourrait m'inspirer mais rien n'en ressort .. 

a = 2
                                Do While Cells(a, 2) <> ""
                                a = a + 1
                                Loop
 
 
                        i = 2 
                                Do While FeDo.Cells(i,1) <> "" 
 
                                If Cells(i, 21) > 0 Then
 
FeT.Cells(a,2).Value=FeDo.Cells(i,1).Value
 
                                a = a + 1
 
                                End If
 
                        i = i + 1
 
        Loop



Le problème c'est qu'il peut arriver que pdt 5-10 lignes il n'y ait rien d'inscrit dans les colonnes...

Merci d'avance pour vos réponse et conseils !

A voir également:

8 réponses

Réponse 1 / 8
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
5 juil. 2011 à 16:55
bonjour

petite précision
je suppose que dans B10:K10 de "fet" tu as des textes? vrai, faux?
0
Réponse 2 / 8
Edaine Messages postés 62 Date d'inscription mercredi 8 juin 2011 Statut Membre Dernière intervention 23 avril 2012
5 juil. 2011 à 17:23
Des entêtes des colonnes oui ^^'
0
Réponse 3 / 8
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
5 juil. 2011 à 17:25
Ok, merci
je regarde demain.
bonne soirée
0
Réponse 4 / 8
Edaine Messages postés 62 Date d'inscription mercredi 8 juin 2011 Statut Membre Dernière intervention 23 avril 2012
6 juil. 2011 à 09:46
Merci :)
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
Réponse 5 / 8
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 6/07/2011 à 10:16
Bonjour

macro proposée 
Private Sub Worksheet_Change(ByVal Target As Range)  
Dim lig1 As Integer, col As Byte, source  
Dim lig2 As Byte  
If Not Intersect(Target, Range("T1:V1000")) Is Nothing And Target > 0 Then  
     lig1 = Target.Row  
     col1 = Target.Column  
     source = Cells(lig1, 1)  
       
     With Sheets("fet")  
          lig2 = .Range("B10:K29").Find("*", .Range("B10"), , , , xlPrevious).Row  
          If lig2 = 29 Then GoTo sature  
          lig2 = lig2 + 1  
            
          Select Case col1  
          Case Is = 20  
               .Cells(lig2, 2) = source  
          Case Is = 21  
               .Cells(lig2, 6) = source  
          Case Is = 22  
               .Cells(lig2, 9) = source  
          End Select  
          .Activate  
     End With  
End If  
Exit Sub
  
sature:  
MsgBox "tableau de destination saturé", vbExclamation

End Sub

demo
https://www.cjoint.com/?3GgkkFr4PZK

Pour installer
copier cette macro
clic droit sur le nom d'onglet "fedo" -visualiser le code
coller la macro
Michel
0
Edaine Messages postés 62 Date d'inscription mercredi 8 juin 2011 Statut Membre Dernière intervention 23 avril 2012
6 juil. 2011 à 10:18
Désolée, au boulot je peux pas lire le fichier joint... ^^'

Je vais tester ça .. Mais ça me semble si loin de ce que je pensai x_O

Bon allez je regarde ! ^^
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 6/07/2011 à 10:21
Mais ça me semble si loin de ce que je pensai x_O

Merci quand même
0
Réponse 6 / 8
Edaine Messages postés 62 Date d'inscription mercredi 8 juin 2011 Statut Membre Dernière intervention 23 avril 2012
6 juil. 2011 à 10:21
Wha, je comprends rien au code ...

Mais pourquoi une Worsheet Change?

Je veux le faire moi même en faite... C'est comme une sorte de synthèse.
0
Réponse 7 / 8
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
6 juil. 2011 à 10:23
...
0
Réponse 8 / 8
Edaine Messages postés 62 Date d'inscription mercredi 8 juin 2011 Statut Membre Dernière intervention 23 avril 2012
Modifié par Edaine le 6/07/2011 à 10:29
:s
Enfaite mon fichier se modifie déjà en Worsheet Change ...

Du coup si je met cette macro en Worksheet Change elle va devenir cinglée ^^'
0
Edaine Messages postés 62 Date d'inscription mercredi 8 juin 2011 Statut Membre Dernière intervention 23 avril 2012
6 juil. 2011 à 10:48
Voilà ce que j'ai commencé .. 

Sub GRA()

Dim FeDo As Worksheet
Dim FeT As Worksheet

Set FeT = Sheets("Feuille Type")
Set FeDo = Sheets("Douchette")

                        

                        i = 2
                                Do While FeDo.Cells(i, 1) <> ""

                                If FeDo.Cells(i, 21) > 0 Then
                                


FeT.Range("F11").Offset(Application.WorksheetFunction.CountA(Range("F11:F29")), 0).Value = FeDo.Cells(i, 1).Value

FeT.Range("G11").Offset(Application.WorksheetFunction.CountA(Range("G11:G29")), 0).Value = FeDo.Cells(i, 2).Value

FeT.Range("H11").Offset(Application.WorksheetFunction.CountA(Range("H11:H29")), 0).Value = FeDo.Cells(i, 21).Value


                                a = a + 1

                                End If

                        i = i + 1
                                Loop
            
   

End Sub
0

Discussions similaires

changer police pseudo
Hunter -
... -

1 réponse
Police d'écriture style "vieux journal"
joshua87 -
,,,,, -

3 réponses