Modif vba - insertion ligne d'apres valeur

[AlCapone]

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

 

[Paf]

Re : Modif vba - insertion ligne d'apres valeur

Bonjour,

La modif :

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+

 

[AlCapone]

Re : Modif vba - insertion ligne d'apres valeur

Merci PAF,

J'ai un message d'erreur "Erreur de compilation : End If sans bloc If".

Ci joint une base test avec le code.

Cordialement,

 

[Paf]

Re : Modif vba - insertion ligne d'apres valeur

Re,

retirer le End If juste après la ligne

TabFinal(j, x) = MonTAb(i, j)

ça devrait le faire

A+

 

[AlCapone]

[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.

 

[Paf]

Re : Modif vba - insertion ligne d'apres valeur

re,

ah ben oui !

pas en forme aujourd'hui et surtout pas testé !!!

Bonne suite