Boucle sans do
Résolu
manu6783
-
manu6783 -
manu6783 -
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
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
A voir également:
- Boucle sans do
- My people do - Télécharger - Organisation
- Do not turn off target traduction - Forum Samsung
- Samsung galaxy tab S Bloquer Downloading do not turn off target - Forum Téléphones & tablettes Android
- Mon pc s'allume et s'éteint en boucle ✓ - Forum Matériel & Système
- Boucle excel sans macro - Forum Excel
4 réponses
Bonjour,
Au cas ou tu n'aurais pas encore trouvé, ça pourra te dépanner
;)
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
;)
Bonjour,
Excusez l'incruste mais je pense qu'elle sera utile à vous deux.
Optimisation de la macro de Yoda
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.
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.
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..
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.
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.
Merci encore
Do Until Cells(lig, 3).Value = "File pavé / Bordures / Caniveaux"
par celle-ci
Do Until Cells(lig, 3).Value = Range("K2").Value
;)