Modif vba - insertion ligne d'apres valeur

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 !

AlCapone

XLDnaute Nouveau
Bonjour à tous,

Après avoir récupérer le super code ci-dessous (de PAF, pour ne pas le citer), je souhaiterai insérer les lignes, non plus d'après des valeurs (TabCible = Array...), mais si la cellule est "non vide" afin de m'éviter de renseigner les 50 valeurs possibles sur un autre fichier.


Sub DupliqueLigne()
Dim MonTAb, TabCible, TabFinal(), i As Long, j As Long, Flag As Boolean, x As Long

TabCible = Array("HC30MB", "13OTHTAX") 'liste des codes pour lesquels on duplique la ligne

With Worksheets("IMPORT")

MonTAb = .Range("A2:O" & .Range("A" & .Rows.Count).End(xlUp).Row)
For i = LBound(MonTAb) To UBound(MonTAb)
Flag = False
x = x + 1
ReDim Preserve TabFinal(1 To UBound(MonTAb, 2), 1 To x)
For j = LBound(MonTAb, 2) To UBound(MonTAb, 2)
TabFinal(j, x) = MonTAb(i, j)
Next j

For j = LBound(TabCible) To UBound(TabCible)
If MonTAb(i, 10) = TabCible(j) Then
Flag = True
Exit For
End If
Next j
If Flag Then ' si correspondance
x = x + 1
ReDim Preserve TabFinal(1 To UBound(MonTAb, 2), 1 To x)
For j = LBound(MonTAb, 2) + 1 To UBound(MonTAb, 2)
TabFinal(j, x) = MonTAb(i, j)
Next j
TabFinal(1, x) = "A"
End If
Next i
.Range("A2:O" & .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents
.Range("A2").Resize(UBound(TabFinal, 2), UBound(TabFinal, 1)) = Application.Transpose(TabFinal)
End With
End Sub



J'ai essayé de comprendre, mais là ça me dépasse vraiment trop.

Merci pour votre partage et une bonne fin de journée

Bien cordialement

AlCapone
 
Re : Modif vba - insertion ligne d'apres valeur

Bonjour,

La modif :

Code:
Sub DupliqueLigne()
 Dim MonTAb, TabCible, TabFinal(), i As Long, j As Long, Flag As Boolean, x As Long

 With Worksheets("IMPORT")

 MonTAb = .Range("A2:O" & .Range("A" & .Rows.Count).End(xlUp).Row)
 For i = LBound(MonTAb) To UBound(MonTAb)
    x = x + 1
    ReDim Preserve TabFinal(1 To UBound(MonTAb, 2), 1 To x)
    For j = LBound(MonTAb, 2) To UBound(MonTAb, 2)
        TabFinal(j, x) = MonTAb(i, j)
    Next j

    If MonTAb(i, 10) <> "" Then
        x = x + 1
       ReDim Preserve TabFinal(1 To UBound(MonTAb, 2), 1 To x)
       For j = LBound(MonTAb, 2) + 1 To UBound(MonTAb, 2)
       TabFinal(j, x) = MonTAb(i, j)
    End If
    TabFinal(1, x) = "A"
    End If
 Next i
 .Range("A2:O" & .Range("A" & .Rows.Count).End(xlUp).Row).ClearContents
 .Range("A2").Resize(UBound(TabFinal, 2), UBound(TabFinal, 1)) = Application.Transpose(TabFinal)
 End With
End Sub

Non testé, pas de classeur test.

A+
 
[RESOLU] Modif vba - insertion ligne d'apres valeur

Merci pour ta réactivité,

J'avais encore le même code d'erreur, mais j'ai vu qu'il manquait "Next j" (par rapport à ta première version) à la place du "End If" que tu m'as demandé de supprimer. Et ça fonctionne nickel !

Encore un grand merci.
 
- 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

Réponses
3
Affichages
569
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
481
  • Question Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
727
Réponses
10
Affichages
714
Réponses
40
Affichages
2 K
Réponses
3
Affichages
485
Retour