XL 2021 VBA créer une ligne quand la cellule est > 0

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

ChloeVBA

XLDnaute Nouveau
Bonjour

J'ai un très long fichier pour lequel je souhaiterais intégrer une Macro :
Département 00800 00832 06282 Etc
0 0 0
32 0 25
0 0 72
L'objectif est de créer une nouvelle ligne à chaque montant différent de 0 et que ce montant soit recopié sur cette nouvelle ligne (sachant que parfois j'ai plusieurs montants sur une même ligne mais que j'ai besoin de créer 1 ligne à chaque montant, soit plusieurs nouvelles lignes pour chaque ancienne ligne). Et ensuite j'ai besoin d'ajouter sur chaque nouvelle ligne le nom de la colonne concernée :
de la colonne G à la colonne BB pour chaque cellule de la ligne différente de 0 créer une nouvelle ligne et copier la valeur sur cette nouvelle ligne
et ajouter en colonne F le nom de la colonne sur la nouvelle ligne

J'espère que c'est à peu près clair...

Merci mille fois à celui qui arrivera à solutionner mon casse-tête !
 

Pièces jointes

Dernière édition:
Solution
Re,
Dans la PJ précédente lorsqu'on appuie plusieurs fois sur le bouton on duplique les comptes.
Donc une version corrigée avec :
VB:
Sub Dispatch()
    Dim DL%, L%, C%
    Application.ScreenUpdating = False
    DL = Application.Max([B65500].End(xlUp).Row, [F65500].End(xlUp).Row)
    For L = DL To 4 Step -1
        If Cells(L, "B") <> "" Then
            For C = 7 To 54
                If Cells(L, C) > 0 And Cells(L, "F") <> "." Then
                    If Cells(L + 1, "F") <> Cells(3, C) Then
                        Rows(L + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                        Cells(L + 1, C) = Cells(L, C)
                        Cells(L + 1, "F") = Cells(3, C)
                    End If
                End If...
Capture.JPG
 
Bonjour Chloe, et bienvenue sur XLD,
Un essai en PJ avec :
VB:
Sub Dispatch()
    Dim DL%, L%, C%
    Application.ScreenUpdating = False
    DL = [B65500].End(xlUp).Row
    For L = DL To 4 Step -1
        For C = 7 To 54
            If Cells(L, C) > 0 Then
                Rows(L + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Cells(L + 1, C) = Cells(L, C)
                Cells(L + 1, "F") = Cells(3, C)
            End If
        Next C
    Next L
End Sub
Le bouton gris ne sert qu'à revenir au tableau de base pour faire des test.
 

Pièces jointes

Re,
Dans la PJ précédente lorsqu'on appuie plusieurs fois sur le bouton on duplique les comptes.
Donc une version corrigée avec :
VB:
Sub Dispatch()
    Dim DL%, L%, C%
    Application.ScreenUpdating = False
    DL = Application.Max([B65500].End(xlUp).Row, [F65500].End(xlUp).Row)
    For L = DL To 4 Step -1
        If Cells(L, "B") <> "" Then
            For C = 7 To 54
                If Cells(L, C) > 0 And Cells(L, "F") <> "." Then
                    If Cells(L + 1, "F") <> Cells(3, C) Then
                        Rows(L + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                        Cells(L + 1, C) = Cells(L, C)
                        Cells(L + 1, "F") = Cells(3, C)
                    End If
                End If
            Next C
            Cells(L, "F") = "."
        End If
    Next L
End Sub
Pour les lignes déjà traitées je mais un point en colonne F pour lever toute ambiguïté future.
 

Pièces jointes

Bonjour Chloe, et bienvenue sur XLD,
Un essai en PJ avec :
VB:
Sub Dispatch()
    Dim DL%, L%, C%
    Application.ScreenUpdating = False
    DL = [B65500].End(xlUp).Row
    For L = DL To 4 Step -1
        For C = 7 To 54
            If Cells(L, C) > 0 Then
                Rows(L + 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                Cells(L + 1, C) = Cells(L, C)
                Cells(L + 1, "F") = Cells(3, C)
            End If
        Next C
    Next L
End Sub
Le bouton gris ne sert qu'à revenir au tableau de base pour faire des test.
oh super merci beaucoup !!!!!
 
Bonjour,
Une autre solution, utilisant Power Query (en natif dans ta version d'Excel)
Dans le fichier joint, 2 requêtes issues de ta base de données :
- Req1, qui restitue le tableau tel que tu le voulais dans la demande
- Req2, qui restitue tous les montants par département sur 1 colonne
Le Tableau Structuré de l'onglet "Base" se nomme "T_Data"
Pour mettre à jour, ruban "Données", "Actualiser tout"
Bonne apm
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour