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

vistla

XLDnaute Junior
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 !
 

Pièces jointes

  • exemple.xlsx
    11.4 KB · Affichages: 4

vgendron

XLDnaute Barbatruc
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

XLDnaute Junior
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

XLDnaute Barbatruc
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
 

Discussions similaires

Statistiques des forums

Discussions
311 724
Messages
2 081 937
Membres
101 844
dernier inscrit
pktla