Piste sur écriture d'une macro !

Edaine Messages postés 63 Statut Membre -  
Edaine Messages postés 63 Statut Membre -
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

michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
bonjour

petite précision
je suppose que dans B10:K10 de "fet" tu as des textes? vrai, faux?
0
Edaine Messages postés 63 Statut Membre
 
Des entêtes des colonnes oui ^^'
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
Ok, merci
je regarde demain.
bonne soirée
0
Edaine Messages postés 63 Statut Membre
 
Merci :)
0

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

Posez votre question
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
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 63 Statut Membre
 
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 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
Mais ça me semble si loin de ce que je pensai x_O

Merci quand même
0
Edaine Messages postés 63 Statut Membre
 
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
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
...
0
Edaine Messages postés 63 Statut Membre
 
: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 63 Statut Membre
 
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