Macro pour insertion de plusieur ligne selon un critère

[Bambi35]

Macro pour insertion de plusieur ligne selon un critère (RESOLU)

Bonjour

J'aimerais connaître une macro pour pouvoir rajouter des lignes sous la ligne de base selon certaine info des cellules de la même ligne
Merci

Bonjour Grand Chaman Excel


Merci de votre retour aussi rapide
Votre macro est ce que j’attendais
Mais Voici le fichier en taille réel que j'utilise et dont j'aimerais appliquer la macro
Colonne Y à AP Données pour le rajout des linges
Exemple : La ligne 6 se duplique 2 Fois pour le Nom 2 Chloé
Ligne 1 DESSIN ENFANTS
Ligne 2 GYM ENFANTS
Ligne 3 STEP
Et que les infos des colonnes C à X se dupliquent aussi dans les nouvelles lignes
Ainsi le fonction en colonne B récupère l'activité indique entre la Y et AP de chaque ligne
Pour pouvoir effectuer un filtre automatique en B
Merci encore Grand Chaman Excel

 

[Grand Chaman Excel]

Re : Macro pour insertion de plusieur ligne selon un critère

Bonjour Bambi35 et bienvenue sur le forum,

Voici une proposition. Tu n'as qu'à sélectionner la plage à convertir (ex B4 à G7) et ensuite une cellule de destination.

Sub InsereLignes()
    Dim p As Range, p2 As Range
    Dim L As Integer, C As Integer, i As Integer, j As Integer
    Dim tablo() As Variant, tablo2() As Variant
    
    Set p = Application.InputBox("Choisir la plage à convertir", , , , , , , 8)
    Set p2 = Application.InputBox("Chsoir la cellule de destination", , , , , , , 8)
    
    L = p.Rows.Count
    C = p.Columns.Count
    
    ReDim tablo(1 To C, 1 To L)
    ReDim tablo2(1 To C, 1 To 1)
    tablo = Application.Transpose(p)
    

    For j = 1 To L
        For i = 2 To C
            If Len(tablo(i, j)) <> 0 Then
                ReDim Preserve tablo2(1 To C, 1 To UBound(tablo2, 2) + 1)
                tablo2(i, UBound(tablo2, 2)) = tablo(i, j)
                tablo2(1, UBound(tablo2, 2)) = tablo(1, j)
            End If
        Next i
    Next j
    
p2.Cells(1, 1).Offset(-1, 0).Resize(UBound(tablo2, 2), UBound(tablo2, 1)) = Application.Transpose(tablo2)

End Sub

A+

 

[Bambi35]

Re : Macro pour insertion de plusieur ligne selon un critère

Bonjour Grand Chaman Excel



Merci de votre retour aussi rapide
Votre macro est ce que j’attends
Mais impossible de le modifier seul pour le fichier ci-joint.
j'ai vraiment besoin de l'aide.


Merci de votre aide

@+++++++++++

 

[Grand Chaman Excel]

Re : Macro pour insertion de plusieur ligne selon un critère

Bonsoir Bambi35,

En effet, la 1re macro proposée ne pouvait pas vraiment fonctionner avec le vrai fichier. Voici donc ton fichier en retour avec une macro différentes appelée "InsérerLignes2". Cela semble bien fonctionner avec les tests que j'ai faits.

A+

 

[Bambi35]

Re : Macro pour insertion de plusieur ligne selon un critère

Bonjour Grand Chaman Excel

J'ai selectionné la plage A4;AP29 et lancer la macro "InsérerLignes2"
J'ai une erreur d'exécution'1004' Erreur définie par l'application ou par défaut.
Désolé

 

[Pierrot93]

Re : Macro pour insertion de plusieur ligne selon un critère

Bonjour,

peut être indiquer quelle est la ligne de code qui provoque cette erreur... En jaune lors du débogage...

bonne journée
@+

 

[Grand Chaman Excel]

Re : Macro pour insertion de plusieur ligne selon un critère

Bonjour Bambi35,

Tel que suggéré par Pierrot93, s'il était possible d'indiquer à quelle ligne ça plante, ça pourrait aider à débugger.

Une précision : pour cette macro, il n'est pas nécessaire de sélectionner la plage à convertir. La macro considère que le tableau commence à la colonne A et que la ligne de titre est la ligne 3. Il faut aussi indiquer dans le code de la macro à quelle colonne les "données" commencent et se terminent. Ici, j'ai mis que la colonne de début était 25 (Y) et que la colonne de fin était 42 (AP). Il faudra le changer si ce n'est pas le cas.

Dans mon fichier précédent, la macro s'éxécutait uniquement si l'onglet s'appelait "Base". Peut-être que l'erreur vient de là. J'ai changé la macro pour qu'elle s'exécute sur l'onglet actif.

Sub InsereLignes2()
    Dim rg As Range
    Dim ColDonnees1 As Integer, ColDonnees2 As Integer
    Dim Nb As Integer, i As Integer, j As Integer
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    
    ColDonnees1 = 25    'colonne Y
    ColDonnees2 = 42    'colonne AP
    
    '1re cellule du tableau, adapter si nécessaire
    Set ws = ActiveSheet
    Set rg = ws.Range("A4")

    Do Until IsEmpty(rg)
        Nb = Application.CountA(Range(ws.Cells(rg.Row, ColDonnees1), ws.Cells(rg.Row, ColDonnees2)))

        If Nb > 1 Then
        'on doit insérer une ligne
            For i = 1 To Nb - 1
                rg.EntireRow.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove
                rg.Resize(1, ColDonnees1 - 1).Offset(-1, 0).FormulaR1C1 = rg.Resize(1, ColDonnees1 - 1).Offset(0, 0).FormulaR1C1
                For j = ColDonnees1 To ColDonnees2
                    If Cells(rg.Row, j) <> "" Then
                        Cells(rg.Row - 1, j) = Cells(rg.Row, j)
                        Cells(rg.Row, j) = ""
                        GoTo Prochain
                    End If
                Next j
Prochain:
            Next i
        End If
    
    
    Set rg = rg.Offset(1, 0)
    Loop
    
    Application.ScreenUpdating = True

End Sub

A+

 

[Bambi35]

Re : Macro pour insertion de plusieur ligne selon un critère

Bonjour

Voici une capture d'écran


Merci encore

 

[Grand Chaman Excel]

Re : Macro pour insertion de plusieur ligne selon un critère

Bonjour,

Bizarre, je n'ai pas ce problème ici...
Peux-tu essayer en écrivant "On error resume next", au début du code ou juste avant la ligne erreur en jaune. Ce n'est pas très joli, mais ça pourrait résoudre le problème.
Quelle version d'Excel utilises-tu ?

 

[Grand Chaman Excel]

Re : Macro pour insertion de plusieur ligne selon un critère

Bonjour,

Tu pourrais aussi essayer cette version modifiée :

Sub InsereLignes3()
    Dim rg As Range
    Dim ColDonnees1 As Integer, ColDonnees2 As Integer
    Dim Nb As Integer, i As Integer, j As Integer
    Dim ws As Worksheet
    Dim rgC As Range, rgP As Range
    
    Application.ScreenUpdating = False
    
    ColDonnees1 = 25    'colonne Y
    ColDonnees2 = 42    'colonne AP
    
    '1re cellule du tableau, adapter si nécessaire
    Set ws = ActiveSheet
    Set rg = ws.Range("A4")

    Do Until IsEmpty(rg)
        Nb = Application.CountA(Range(ws.Cells(rg.Row, ColDonnees1), ws.Cells(rg.Row, ColDonnees2)))

        If Nb > 1 Then
        'on doit insérer une ligne
            For i = 1 To Nb - 1
                rg.EntireRow.Insert shift:=xlDown, copyorigin:=xlFormatFromLeftOrAbove
                Set rgC = rg.Resize(1, ColDonnees1 - 1)
                Set rgP = rg.Offset(-1, 0)
                rgC.Copy rgP
                For j = ColDonnees1 To ColDonnees2
                    If Cells(rg.Row, j) <> "" Then
                        Cells(rg.Row - 1, j) = Cells(rg.Row, j)
                        Cells(rg.Row, j) = ""
                        GoTo Prochain
                    End If
                Next j
Prochain:
            Next i
        End If
    
    
    Set rg = rg.Offset(1, 0)
    Loop
    
    Application.ScreenUpdating = True

End Sub

A+

 

[Bambi35]

Re : Macro pour insertion de plusieur ligne selon un critère

Bonjour Grand Chaman Excel

Pour info
La première solution avec "On error resume next"
Les lignes se décalent vers le bas mais ne copie pas les infos
Voir fichier joint " erreur"

Pour la deuxième solution le top !!!!!!!!
Voir fichier super

Je te remercie de ton aide car je suis un novice sur les macros
et on peut compte sur ton aide

Je vais donc mettre en application ta macro pour gérer les inscriptions sportive plus facilement


@ ++++++++++

Merci encore

NB : peut-être que je demanderai encore de l'aide pour perfectionner le fichier

 

[Bambi35]

Re : Macro pour insertion de plusieur ligne selon un critère + bordure

Bonjour

Suite au fichier éditer par Grand Chaman Excel "super" J'ai complété la macro pour intégrer l'ajout de 7 colonnes
Mais je ne sait pas comment faire pour que la macro entoure les cellules des 7 colonnes jusqu'a la dernière ligne non vide
(Contour simple et le nombre de ligne n'est pas régulier )

NB/
Le fichier est en état il faut lancer la macro
Merci d'avance

 

[Grand Chaman Excel]

Re : Macro pour insertion de plusieur ligne selon un critère

Bonjour,

Voici ton fichier en retour... je me suis permis de faire un peu de ménage dans ton code...

A+

 

[Bambi35]

Re : Macro pour insertion de plusieur ligne selon un critère

Bonjour Grand Chaman Excel

Un grand merci pour votre aide pour réaliser se fichier pour gérer les inscriptions sportive et pas de problème pour avoir faire un peu de ménage dans le code.
Je l'ai exécuter sur le fichier comportant 256 lignes et super

Merci encore
@++++++++