Créer une boucle

Résolu
Bonjour,

Bonjour,

Je pratique un peu la programmation sous VBA mais j'ai encore quelques souci dans la rédaction de programme avec boulce i.
Voici le programme que j'ai réalisé pour une ligne (ligne 3) et que je veux exécuter sur un nombre de ligne indéfini (environ 100) à partir de la ligne 3 avec l'aide d'un compteur.
________________

Private Sub Image4_Click()

With Sheets("Point Ordo-Montage FKG1")

Sheets("Mail FKG1").Range("B3") = .Range("B3") & vbLf & .Range("C3") & vbLf & .Range("E3") & vbLf & .Range("F3")
Sheets("Mail FKG1").Range("C3") = .Range("A3") & vbLf & .Range("D3") & vbLf & .Range("G3")
Sheets("Mail FKG1").Range("D3") = .Range("H3")
Sheets("Mail FKG1").Range("E3") = .Range("I3")
Sheets("Mail FKG1").Range("F3") = .Range("J3")
Sheets("Mail FKG1").Range("G3") = .Range("K3")
Sheets("Mail FKG1").Range("H3") = .Range("L3")
Sheets("Mail FKG1").Range("I3") = .Range("M3")
Sheets("Mail FKG1").Range("J3") = .Range("N3")
Sheets("Mail FKG1").Range("K3") = .Range("O3")
Sheets("Mail FKG1").Range("L3") = .Range("P3")
Sheets("Mail FKG1").Range("M3") = .Range("Q3")
Sheets("Mail FKG1").Range("N3") = .Range("R3")

End With

End Sub
_________________

Merci de me donner une solution à mon problème.

5 réponses

  • Votes
  • Date
  • Date décroissante
  1. Utiliser plutot
    Range Sheets("Mail FKG1").Cells(num_ligne,num_colonne)
    qui permettra de boucler sur num_ligne
    et pourquoi pas aussi sur num_colonne
    1. Contributeur
      bonjour

      hormis le fait de passer en cells comme te propose fort justement CCM1

      tu peux réduire le nombre de ligne de ta macro par:

      With Sheets("Point Ordo-Montage FKG1")   
          Application.ScreenUpdating = False   
          Sheets("Mail FKG1").Range("B3") = .Range("B3") & vbLf & .Range("C3") & vbLf & .Range("E3") & vbLf & .Range("F3")   
          Sheets("Mail FKG1").Range("C3") = .Range("A3") & vbLf & .Range("D3") & vbLf & .Range("G3")   
          bloc = .Range("H3:R3").Value   
          Sheets("Mail FKG1").Range("D3:N3") = bloc   
      End With

      à passer en cells au lieu de range, bien entendu

      pour ta boucle
      Sub Image4_Click()   
      Dim derlig As Byte, lig As Byte   
      With Sheets("Point Ordo-Montage FKG1")   
          Application.ScreenUpdating = False   
          derlig = .Range("A250").End(xlUp).Row   
          For lig=3 to derlig   
             'ton code (avec par exemple cells(lig,"A")   
          next   
      end with


      A toi de jouer et de gagner
      évite les "i", "j" comme nom de variable (au moins 3 caractères) malgré qu'on le voit hélas trop souvent (maintenance du logiciel)
      Michel
      1. Merci Michel pour ta réponse,

        Par contre la ligne suivante : bloc = .Range("H3:R3").Value
        ne marche pas et est signalé une erreur de syntaxe.
        J'ai essayé de faire la modif selon la boucle: bloc = .Range(lig,"H":lig,"R").value
        mais cela ne marche pas non plus!!

        Peux tu m'expliquer ça et me dire par la même occasion si le code ci dessous conviens pour éviter que je te redemande ça plus tard:
        ________________________

        Private Sub Image4_Click()

        Dim derlig As Byte, lig As Byte
        Dim bloc As Byte

        With Sheets("Point Ordo-Montage FKG1")
        Application.ScreenUpdating = False

        derlig = .Range("A250").End(xlUp).Row
        For lig = 3 To derlig

        Sheets("Mail FKG1").Cells(lig, "B") = .Range("B3") & vbLf & .Range("C3") & vbLf & .Range("E3") & vbLf & .Range("F3")
        Sheets("Mail FKG1").Cells(lig, "C") = .Range("A3") & vbLf & .Range("D3") & vbLf & .Range("G3")
        bloc = .Range("H3":"R3").Value
        Sheets("Mail FKG1").Range("D3:N3") = bloc

        Next

        End With

        End Sub

        ______________________
        Merci de ton aide
        1. Contributeur
          re,

          Tu as mis un guillemet parasite
          .Range("H3":"R3").Value

          au lieu de range("H3:R3")

          mais comme tu décales d'une ligne a chaque boucle
          Sheets("Mail FKG1").Range("D3:N3") = bloc

          devient
          Sheets("Mail FKG1").range(cells(lig,"D"),cells(lig,"N"))=bloc

          mais il y a un truc que je ne comprends pas: tu recopies toujours la ligne 3 de "Point Ordo-Montage FKG1" vers "Mail FKG1" ?
      2. Re Michel,

        Petite pause en formation et je reprends mon problème. Pour t'expliquer l'objectif de mon programme en quelques mots:
        - J'ai créé sans boucle un programme qui copie des lignes d'une feuille pour les mettre sur une autre feuille sous un format différent.
        - Mon premier message posté (voir ci-dessus) représente le code exécuté pour la ligne 3 et celui-ci recopié 18 fois pour 18 lignes maxi acceptée par le programme VBA.
        - Donc l'objectif de ma demande est de reproduire le code de mon premier message sur un nombre de ligne "remplies" indéfinies.

        pour info, la modif que tu me conseil crée toujours un BUG!!!

        ____________________________
        Private Sub Image4_Click()

        Dim derlig As Byte, lig As Byte
        Dim bloc As Byte

        With Sheets("Point Ordo-Montage FKG1")
        Application.ScreenUpdating = False

        derlig = .Range("A250").End(xlUp).Row
        For lig = 3 To derlig

        Sheets("Mail FKG1").Cells(lig, "B") = .Range("B3") & vbLf & .Range("C3") & vbLf & .Range("E3") & vbLf & .Range("F3")
        Sheets("Mail FKG1").Cells(lig, "C") = .Range("A3") & vbLf & .Range("D3") & vbLf & .Range("G3")
        bloc = .Range(Cells(lig, "H"), Cells(lig, "R")).Value
        Sheets("Mail FKG1").Range(Cells(lig, "H"), Cells(lig, "R")) = bloc

        Next

        End With

        End Sub
        ___________________________
        Arrivez tu à me dire où est le souci???
        Merci Michel
        1. Modérateur
          Bonjour,
          Suite à échanges matinaux...

          Private Sub Image4_Click() 
          Dim DernLign As Integer, Lign As Integer
          With Sheets("Point Ordo-Montage FKG1") 
              DernLign = .Cells(65536, 4).End(xlUp).Row
                  For Lign = 3 To DernLign
                      Sheets("Mail FKG1").Cells(Lign, 2) = .Cells(Lign, 2) & vbLf & .Cells(Lign, 3) & vbLf & .Cells(Lign, 5) & vbLf & ..Cells(Lign, 6)  
                      Sheets("Mail FKG1").Cells(Lign, 3)  = .Cells(Lign, 1) & vbLf & .Cells(Lign, 4) & vbLf & .Cells(Lign, 7) 
                      Sheets("Mail FKG1").Cells(Lign, 4)  = .Cells(Lign, 8) 
                      Sheets("Mail FKG1").Cells(Lign, 5)  = .Cells(Lign, 9) 
                      Sheets("Mail FKG1").Cells(Lign, 6)  = .Cells(Lign, 10) 
                      Sheets("Mail FKG1").Cells(Lign, 7)  = .Cells(Lign, 11) 
                      Sheets("Mail FKG1").Cells(Lign, 8)  = .Cells(Lign, 12) 
                      Sheets("Mail FKG1").Cells(Lign, 9)  = .Cells(Lign, 13) 
                      Sheets("Mail FKG1").Cells(Lign, 10)  = .Cells(Lign, 14) 
                      Sheets("Mail FKG1").Cells(Lign, 11)  = .Cells(Lign, 15) 
                      Sheets("Mail FKG1").Cells(Lign, 12)  = .Cells(Lign, 16) 
                      Sheets("Mail FKG1").Cells(Lign, 13)  = .Cells(Lign, 17) 
                      Sheets("Mail FKG1").Cells(Lign, 14)  = .Cells(Lign, 18) 
              Next Lign
          End With 
          End Sub 

          Pour une meilleure compréhension, je t'ai laissé le "schéma" de code initial. Sache qu'il est possible de le raccourcir, en suivant la méthode décrite ci dessus par michel_m, que je re-salue au passage.

          ps : je vais faire fermer l'autre sujet, inutile à présent...