Macro saut de ligne lorsqu'un nombre finissant par "0" apparaît
1 réponse
arnours
Bonjour,
je souhaiterai incorporer dans une macro la fonction suivante:
j'ai un tableau généré automatiquement avec beaucoup de références.
Il faudrait que si je trouve le un numéro finissant par "0" (du type 24000 ou 25000) dans la ligne, la macro insère une ligne blanche sur la ligne en dessous.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Michd
Bonjour, Ceci devrait le boulot... 'Adapte le nom de la feuille et de la plage de cellules '--------------------------------------------------------- Sub test() Dim Rg As Range, Trouve As Range Dim Adr As String 'Adapte le nom de la feuille et de la plage de cellules With Worksheets("Feuil1") Set Rg = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row) End With With Rg.EntireRow Set Trouve = .Find(What:="*" & 0, LookIn:=xlValues, _ LookAt:=xlPart, searchOrder:=xlByRows, searchdirection:=xlNext) If Not Trouve Is Nothing Then Adr = Trouve.Address On Error GoTo GestionError Do Trouve.Offset(1).EntireRow.Insert If Trouve.Row >= Rg(Rg.Rows.Count) Then Exit Do End If Set Trouve = .FindNext(Trouve.Offset(1)) Loop Until Trouve.Address = Adr End If End With GestionError: Exit Sub End Sub '--------------------------------------------------------- MichD
Bonjour,
Ceci devrait le boulot...
'Adapte le nom de la feuille et de la plage de cellules
'---------------------------------------------------------
Sub test()
Dim Rg As Range, Trouve As Range
Dim Adr As String
'Adapte le nom de la feuille et de la plage de cellules
With Worksheets("Feuil1")
Set Rg = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
End With
With Rg.EntireRow
Set Trouve = .Find(What:="*" & 0, LookIn:=xlValues, _
LookAt:=xlPart, searchOrder:=xlByRows, searchdirection:=xlNext)
If Not Trouve Is Nothing Then
Adr = Trouve.Address
On Error GoTo GestionError
Do
Trouve.Offset(1).EntireRow.Insert
If Trouve.Row >= Rg(Rg.Rows.Count) Then
Exit Do
End If
Set Trouve = .FindNext(Trouve.Offset(1))
Loop Until Trouve.Address = Adr
End If
End With
GestionError:
Exit Sub
End Sub
'---------------------------------------------------------
Bonjour, Ceci devrait le boulot... 'Adapte le nom de la feuille et de la plage de cellules '--------------------------------------------------------- Sub test() Dim Rg As Range, Trouve As Range Dim Adr As String 'Adapte le nom de la feuille et de la plage de cellules With Worksheets("Feuil1") Set Rg = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row) End With With Rg.EntireRow Set Trouve = .Find(What:="*" & 0, LookIn:=xlValues, _ LookAt:=xlPart, searchOrder:=xlByRows, searchdirection:=xlNext) If Not Trouve Is Nothing Then Adr = Trouve.Address On Error GoTo GestionError Do Trouve.Offset(1).EntireRow.Insert If Trouve.Row >= Rg(Rg.Rows.Count) Then Exit Do End If Set Trouve = .FindNext(Trouve.Offset(1)) Loop Until Trouve.Address = Adr End If End With GestionError: Exit Sub End Sub '--------------------------------------------------------- MichD
