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 !

8 réponses

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

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

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

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

      Merci quand même
      0
  7. 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
  8. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    ...
    0
  9. 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
    1. 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

Discussions similaires

Bref. Je cherche la police d'écriture de Bref
Ratus -
Calo mnie -

10 réponses
reinitialiser la saisie intuitive
JeanClaudeDefays -
Olivier -

4 réponses