Diviser des lignes

Bonjour,

dans mon fichier j'ai des lignes de longueur différentes, mais avec les mêmes informations toutes les 41 colonnes de la colonne B à AP, de "GROUPE_MACH=Fontaine filtrante" à " CONTROLE=Fait".

je souhaiterais que à chaque fois que nous trouvons une cellule avec "GROUPE_MACH=Fontaine filtrante " insérer une nouvelle ligne en dessous de la précédente qui démarrerait en colonne B.

Dans le fichier exemple joint les lignes 2 à 5 représentent le résultat escompter fait actuellement manuellement , les lignes suivantes le format avant traitement.

Si quelqu'un pouvait m'aider je serais le plus heureux des hommes

Bonjour,

Essayez ceci, ouvrez le fichier et cliquez sur le bouton "Traitement"

le code utilisé:

Sub Traitement()
    Dim DerLig As Long, DerCol As Long, Lig_Dest As Long
    Dim i As Long, j As Long, k As Long
    Dim Nb_Gr As Long, Der_Adr As Long

    Application.ScreenUpdating = False
    DerLig = Range("B" & Rows.Count).End(xlUp).Row
    DerCol = Range("B2").CurrentRegion.Columns.Count
    For i = DerLig To 2 Step -1
        Nb_Gr = Application.WorksheetFunction.CountIf(Range(Cells(i, 1), Cells(i, DerCol)), "GROUPE_MACH=Fontaine filtrante")
        If Nb_Gr > 1 Then
            Der_Adr = (Nb_Gr * 41) + 2
            For j = Der_Adr To 43 Step -41
                If Cells(i, j) = "GROUPE_MACH=Fontaine filtrante" Then
                    Rows(i + 1).Insert Shift:=xlDown
                    Lig_Dest = i + 1
                    Range(Cells(i, j), Cells(i, j + 40)).Cut Cells(Lig_Dest, "B")
                End If
            Next j
        End If
    Next i
End Sub

Cdlt

Bonjour Arturo83,

C'est exactement le résultat espéré, j'ai réussi a le reproduire dans un fichier avec plus de données cela marche impeccable.

Par contre je n'arrive pas a l'intégré à mon fichier final, je pensais que j'arriverais à modifié ta programmation, mais je suis pas assez fort, c'est juste que cela commence en colonne R mais plus B.

Si tu peux m'aidé, pour intégré cela sur mon fichier final, je n'est pas besoin du bouton car la macro sera ajouté à une dizaine d'autres à la fin.

Je te joins le fichier final, avec un grand merci d'avance.

Faites des essais avec ceci, attention je n'ai pas vérifié, donc assurez-vous que le résultat soit correct.

Sub Traitement()
    Dim DerLig As Long, DerCol As Long, Lig_Dest As Long
    Dim i As Long, j As Long, k As Long
    Dim Nb_Gr As Long, Der_Adr As Long

    Application.ScreenUpdating = False
    DerLig = Range("A" & Rows.Count).End(xlUp).Row
    DerCol = Range("A2").CurrentRegion.Columns.Count
    For i = DerLig To 2 Step -1
        Nb_Gr = Application.WorksheetFunction.CountIf(Range(Cells(i, 1), Cells(i, DerCol)), "GROUPE_MACH=Fontaine filtrante")
        If Nb_Gr > 1 Then
            Der_Adr = (Nb_Gr * 41) + 18
            For j = Der_Adr To 59 Step -41
                If Cells(i, j) = "GROUPE_MACH=Fontaine filtrante" Then
                    Rows(i + 1).Insert Shift:=xlDown
                    Lig_Dest = i + 1
                    Range(Cells(i, j), Cells(i, j + 40)).Cut Cells(Lig_Dest, "R")
                End If
            Next j
        End If
    Next i
End Sub

Un grand merci, cela marche très bien.

Cdlt