VBA: Recopier les données d'une ligne dans une nouvelle ligne insérée

Jam

XLDnaute Accro
Bonjour à tous,

J'ai une question toute bête mais je souhaite avoir vos avis concernant la recopie d'une ligne dans une nouvelle ligne insérée juste en-dessous ou au-dessus.
Ma question est surtout liée à la rapidité d'exécution d'un code que je cherche à optimiser car cette opération doit avoir lieu sur de nombres lignes d'un tableau (et que la copie est toujours lente d'un point de vue programmation).

Le code que j'envisage est celui-ci:
VB:
With Rows(x)
    .Copy
    .Insert shift:=xlUp
End With

Merci d'avance pour vos suggestions
 

JBARBE

XLDnaute Barbatruc
Re : VBA: Recopier les données d'une ligne dans une nouvelle ligne insérée

Bonjour à tous,

Un exemple d'insertion ligne avec copy !

Code:
Option Explicit

Sub InsererLignes()
Dim vCompteurLignes As Long
Dim vIntervalle As Long
Dim vLigneDepart As Long
vCompteurLignes = 1 ' variable contenant au fur et à mesure le N° de la ligne en cours
vIntervalle = 2 ' variable contenant le nombre de ligne à sauter avant l'insertion d'une ligne vide
vLigneDepart = 6 ' N° de la premiére ligne du tableau
Do While vCompteurLignes <= ActiveSheet.UsedRange.Rows.Count ' boucle jusqu'à la fin du tableau
  vCompteurLignes = vCompteurLignes + vIntervalle + 1
  Rows(vLigneDepart - 4 + vCompteurLignes).Copy
  Rows(vLigneDepart - 3 + vCompteurLignes).Insert shift:=xlDown
  Application.CutCopyMode = False
Loop
End Sub

A noter que les variables : vCompteurLignes - vIntervalle - vLigneDepart peuvent être modifiées selon besoin !

Dans cette exemple les variables copient une fois sur deux !

bonne journée !
 

Pièces jointes

  • Inserer_Lignes.xls
    53 KB · Affichages: 17

job75

XLDnaute Barbatruc
Re : VBA: Recopier les données d'une ligne dans une nouvelle ligne insérée

Bonjour Jam, [Edit] Dranreb, JBARBE,

L'utilisation de tableaux VBA est toujours beaucoup plus rapide que les manipulations sur les cellules.

Par exemple pour faire un copier/insérer d'une ligne sur deux d'un tableau :

Code:
Sub CopierInsérer()
'une ligne sur 2
Dim F As Worksheet, t1, ncol%, t2(), n&, i&, j%
Set F = Feuil1 'CodeName, à adapter
t1 = F.Range(F.UsedRange, F.UsedRange.Offset(1)) 'au moins 2 éléments
ncol = UBound(t1, 2)
ReDim t2(1 To Int(3 * UBound(t1) / 2 + 1), 1 To ncol)
n = 1
On Error Resume Next 'pour la dernière valeur de t1
For i = 1 To UBound(t1) Step 2
  For j = 1 To ncol
    t2(n, j) = t1(i, j)
    t2(n + 1, j) = t1(i + 1, j)
    t2(n + 2, j) = t1(i + 1, j)
  Next
  n = n + 3
Next
F.UsedRange.Resize(UBound(t2)) = t2
End Sub
Bien entendu seules les valeurs sont copiées.

A+
 
Dernière édition:

job75

XLDnaute Barbatruc
Re : VBA: Recopier les données d'une ligne dans une nouvelle ligne insérée

Bonjour le fil, le forum,

J'ai modifié la macro précédente en utilisant On Error Resume Next.

Pour bien montrer comment ça marche, voici avec une ligne sur 3 :

Code:
Sub CopierInsérer()
'une ligne sur 3
Dim F As Worksheet, t1, ncol%, t2(), n&, i&, j%
Set F = Feuil1 'CodeName, à adapter
t1 = F.Range(F.UsedRange, F.UsedRange.Offset(1)) 'au moins 2 éléments
ncol = UBound(t1, 2)
ReDim t2(1 To Int(4 * UBound(t1) / 3 + 1), 1 To ncol)
n = 1
On Error Resume Next 'pour les dernières valeurs de t1
For i = 1 To UBound(t1) Step 3
  For j = 1 To ncol
    t2(n, j) = t1(i, j)
    t2(n + 1, j) = t1(i + 1, j)
    t2(n + 2, j) = t1(i + 2, j)
    t2(n + 3, j) = t1(i + 2, j)
  Next
  n = n + 4
Next
F.UsedRange.Resize(UBound(t2)) = t2
End Sub
A+
 

job75

XLDnaute Barbatruc
Re : VBA: Recopier les données d'une ligne dans une nouvelle ligne insérée

Re,

avec un 'pas' quelconque :

Code:
Sub CopierInsérer()
'une ligne sur 'pas'
Dim F As Worksheet, t1, ncol%, t2(), n&, i&, j%, k&
Set F = Feuil1 'CodeName, à adapter
pas = 4 'à adapter
t1 = F.Range(F.UsedRange, F.UsedRange.Offset(1)) 'au moins 2 éléments
ncol = UBound(t1, 2)
ReDim t2(1 To Int((pas + 1) * UBound(t1) / pas + 1), 1 To ncol)
n = 1
On Error Resume Next 'pour les dernières valeurs de t1
For i = 1 To UBound(t1) Step pas
  For j = 1 To ncol
    For k = 0 To pas - 1
      t2(n + k, j) = t1(i + k, j)
    Next
    t2(n + pas, j) = t1(i + pas - 1, j)
  Next
  n = n + pas + 1
Next
F.UsedRange.Resize(UBound(t2)) = t2
End Sub
A+
 

Jam

XLDnaute Accro
Re : VBA: Recopier les données d'une ligne dans une nouvelle ligne insérée

Salut à tous,

Merci pour toutes ces biens sympathiques réponses.
Job, j'utilise bien fréquemment les tableaux dont je connais la rapidité d'exécution, la problématique (non indiquée dans mon premier message) tenait aussi au fait que le tableau est mis-en forme et que l'utilisation d'un tableau en mémoire est impossible dans ce cas.
La réponse de Jbarbe étant très proche de la mienne je vais donc conserver mon bout de code et y rajouter juste le Application.CutCopyMode = False qui est bien utile.

Bon courage
 

Discussions similaires

Réponses
8
Affichages
615

Statistiques des forums

Discussions
311 709
Messages
2 081 779
Membres
101 816
dernier inscrit
Jfrcs