Microsoft 365 ajout ligne entre 2 lignes, et déplace données partielle sur nouvelle ligne

vistla · 9 Septembre 2022

Bonjour,

Cela faisait un moment que je n'avais pas sollicité votre aide!

Malgré mes recherches sur le forum, je n'ai pas trouvé de solution à ma problématique.

J'ai un tableau qui va contenir plusieurs lignes (toujours aléatoire d'une fois à l'autre). Je cherche à ajouter une ligne entre chaque enregistrement, et dans cette nouvelle ligne, déplacer toutes les informations contenu à partir de la colonne P de mon fichier.

Dans mon fichier, j'ai mis un onglet avec les données reçue à l'externe, et un 2e onglet avec le résultat attendu.

j'aimerais bien avoir une macro qui me fait le tout automatiquement, et idéalement dans un nouvel onglet afin de ne pas altérer les données d'origine.

Est-ce que quelqu'un aurait une solution simple ?

Merci !

vgendron · 9 Septembre 2022

Hello
une solution ici

VB:

Sub Macro1()
Dim TabSource() As Variant
Dim TabDest() As Variant


With Sheets("DONNEES SOurce")
    TabSource = .UsedRange.Value
End With

ReDim TabDest(1 To 2 * UBound(TabSource, 1), 1 To 15)

For i = LBound(TabSource, 1) To UBound(TabSource, 1)
    For j = 1 To 15
        TabDest(2 * (i - 1) + 1, j) = TabSource(i, j)
    Next j
    
    For j = 16 To UBound(TabSource, 2)
        TabDest(2 * i, j - 15) = TabSource(i, j)
    Next j
Next i

Sheets("Dest").Range("A1").Resize(UBound(TabDest, 1), UBound(TabDest, 2)) = TabDest
End Sub

vistla · 9 Septembre 2022

Bonjour vgendron,

C'est super, un gros merci! C'est exactement ce que je recherchais. beaucoup de temps sera sauvé!

Si je comprend bien le code :
1 to 15 est pour les colonnes.
à partir de la 16e colonne, crée une table TabDest2.

Supposons que je veux la source sur 3 lignes.
disons : 1 to 15 = ligne 1
16 to 18 = ligne 2
19 jusqu'à la fin, sur la ligne 3

Comment pourrais-je adapter ce code facilement ?

vgendron · 9 Septembre 2022

vistla à dit:
crée une table TabDest2.

non non. tu as mal lu. il n'y a qu'un seul tablo de destination

je remet le code avec des commentaires et les lignes à ajouter/modifier pour un dispatch sur 3 lignes

VB:

Sub Macro1()
Dim TabSource() As Variant
Dim TabDest() As Variant


With Sheets("DONNEES SOurce") 'avec la feuille source
    TabSource = .UsedRange.Value 'on met toutes les données dans un tablo vba
End With

ReDim TabDest(1 To 2 * UBound(TabSource, 1), 1 To 15) 'on dimensionne LE tablo de destination avec 2 fois plus de ligne (puisqu'on met les données sur 2 lignes) et 15 colonnes maximum

'si on met sur 3 lignes
'ReDim TabDest(1 To 3 * UBound(TabSource, 1), 1 To 15) 'on dimensionne LE tablo de destination avec 3 fois plus de ligne (puisqu'on met les données sur 3 lignes) et 15 colonnes maximum

For i = LBound(TabSource, 1) To UBound(TabSource, 1) 'pour chaque ligne du tablo source
    For j = 1 To 15 'les 15 premières colonnes
        TabDest(2 * (i - 1) + 1, j) = TabSource(i, j) 'sont mises sur la ligne "2*(i-1)+1
    Next j
    
    For j = 16 To UBound(TabSource, 2) 'les suivantes à partir de 16,
    'ou for j=16 to 18
        TabDest(2 * i, j - 15) = TabSource(i, j) 'sont mises sur la ligne "2*i"
    Next j
    
    'for j=19 to ubound(tabdest,2)
    'TabDest(2 * i + 1, j - 18) = TabSource(i, j) 'sont mises sur la ligne "2*i+1"
    'Next j
Next i

Sheets("Dest").Range("A1").Resize(UBound(TabDest, 1), UBound(TabDest, 2)) = TabDest
End Sub

Microsoft 365 ajout ligne entre 2 lignes, et déplace données partielle sur nouvelle ligne

vistla

XLDnaute Junior

Pièces jointes

vgendron

XLDnaute Barbatruc

vistla

XLDnaute Junior

vgendron

XLDnaute Barbatruc

Discussions similaires