Boucle sans do

Résolu
Bonjour,
Je ne comprend pas l'erreur qui s'affiche à chaque fois dans mon code VBA :
En fait je voudrais que la cellule sélectionnée soit C5, puis que cela descende jusqu'à ce qu'apparaisse le texte "File pavé / Bordures / Caniveaux" par exemple en C6 ( En C5, il y aurait écrit "Enrobés").
A ce moment là, je souhaite une insertion de ligne, puis une copie de la ligne 5 (colonne 1 à 30) pour la copier avec les formules dans la nouvelle ligne C6.
Si l'un de vous pourrait m'indiquer l'erreur je le remercie grandement.

Sub fret_lignerevêtement()
Dim k As Integer
Application.ScreenUpdating = False

Range("C5").Select

' Boucle jusqu'à ce que soit écrit
Do Until Cells(x, 3).Value = "File pavé / Bordures / Caniveaux"

Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

For k = 1 To 30

Cells(ActiveCell.Row - 1, k).Select
Cells(ActiveCell.Row - 1, k).Copy
Cells(ActiveCell.Row, k).PasteSpecial Paste:=xlPasteFormats
Cells(ActiveCell.Row, k).PasteSpecial Paste:=xlPasteFormulas

Next k
Loop

Range("A1").Select
Application.ScreenUpdating = True

End Sub

Cordialement

4 réponses

  1. Bonjour,

    Au cas ou tu n'aurais pas encore trouvé, ça pourra te dépanner

    Sub fret_lignerevêtement() 
     Dim lig As Integer
     Application.ScreenUpdating = False 
     'Range("C5").Select 
     
     lig = 5 'on commence à la ligne 5
     
     Do Until Cells(lig, 3).Value = "File pavé / Bordures / Caniveaux" 
      if Cells(lig, 3).Value = "" then 'si on ne trouve pas le texte on s'arrete
        msgbox "Texte non trouvé"
        exit sub
      end if
      lig = lig + 1
     Loop
    
     Range("A" & lig).Select
     Selection.EntireRow.Insert 'on insere une ligne
     
     Range("A" & lig-1 & ":AD" & lig-1).Select
     Selection.Copy ' on copie 30 colonnes de la ligne précédente 
     
     Range("A" & lig).Select
     ActiveSheet.Paste 'on colle dans la ligne vide
     
     Application.CutCopyMode = False
    
     Range("A" & lig).Select 
     Application.ScreenUpdating = True 
    End Sub 


    ;)
    1. Merci beaucoup cela marche ton code marche très bien. Je m'étais débrouillé en bidouillant un peu mais là c mieux! par contre serait-il possible de ne pas écrire "File pavé / bordures / Caniveaux" dans la macro mais lui dire d'aller chercher ce qu'il y a dans la case K2 par exemple? comme ça je pourrais mettre une liste déroulante avec les différentes catégories et quand je lancerai la macro ça me rajoutera une ligne dans la catégorie correspondante.
      Merci encore
    2. Oui, c'est possible. Il faut juste remplacer la ligne
      Do Until Cells(lig, 3).Value = "File pavé / Bordures / Caniveaux"

      par celle-ci
      Do Until Cells(lig, 3).Value = Range("K2").Value

      ;)
  2. Contributeur
    Bonjour,
    Excusez l'incruste mais je pense qu'elle sera utile à vous deux.
    Optimisation de la macro de Yoda
    Sub fret_lignerevêtement()  
    Dim lig As Integer  
        Application.ScreenUpdating = False  
        lig = 5 'on commence à la ligne 5  
       
        Do Until Cells(lig, 3).Value = [K2]  
            If Cells(lig, 3).Value = "" Then 'si on ne trouve pas le texte on s'arrete  
              MsgBox "Texte non trouvé"  
              Exit Sub  
            End If  
            lig = lig + 1  
        Loop  
    
        Range("A" & lig).EntireRow.Insert  'on insere une ligne  
        Rows(lig - 1).Copy Rows(lig) 'ont la copie  
        Rows(lig).Select  
     'N'est pas nécessaire, remis automatiquement au sortir de la macro.  
     'Application.ScreenUpdating = True  
    End Sub

    A+
    Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
    NOTE : Je ne répond pas aux MP pour les questions techniques.
    1. Contributeur
      Mais je pense que suivant ta dernière demande si en K2 tu a
      File pavé / Bordures / Caniveaux
      Je suppose que c'est à cette rubrique que tu veux ajouter une ligne, alors la macro ne va plus..
      Sub fret_lignerevêtement2() 
      Dim lig As Integer, B As Boolean 
          Application.ScreenUpdating = False 
          For lig = 5 To Cells(Rows.Count, 3).End(xlUp).Row 
              If B Then 
                  If Cells(lig, 3).Value <> [K2] Then 
                      Rows(lig).Insert 
                      Rows(lig - 1).Copy Rows(lig) 'ont la copie 
                      Rows(lig).Select 
                      Exit Sub 
                  End If 
              ElseIf Cells(lig, 3).Value = [K2] Then 
                  B = True 
              End If 
          Next lig 
      'Si la rubrique sélectionnée est la dernière
          Rows(lig - 1).Copy Rows(lig) 'ont la copie 
          Rows(lig).Select 
      End Sub

      Tu dis.

      Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)
      NOTE : Je ne répond pas aux MP pour les questions techniques.
      1. Merci beaucoup a tous les deux! cela m'a grandement aidé et permis de continuer ce que je suis en train de faire, c'est niquel!
        Merci encore!!! Je suis encore très loin d'arriver à écrire des codes comme ça!!