Copie d'une ligne et insertion des données copiées à la ligne suivante

[nikxs360]

Bonjour,

Je souhaite réalisé une macro sur le fichier excel ci-joint me permettant de copier une ligne complète et de l'insérer dans la ligne suivante à condition qu'il y ait au moins 1 caractère dans la colonne G.

J'ai trouvé la macro ci-dessous mais elle ne me copie que les formules et pas les valeurs ou les champs texte.
De plus, je souhaiterais que la macro s'exécute à l'ouverture du fichier.

Sub InsererLignesCopierFormules()
'Macro insère ligne(s) en-dessous de la (ou des) cellule(s) choisie(s) et copie les formules uniquement
'Par : Grand Chaman Excel
'2007-10-02

Dim NbLignes As Integer
Dim NbLignes_a As Integer
Dim SelCol As Integer

Application.ScreenUpdating = False

NbLignes = Selection.Rows.Count 'Nombre de lignes dans la sélection
NbLignes_a = NbLignes
SelCol = Selection.Cells(1, 1).Column

If NbLignes > 1 Then
'On choisit la 1re ligne entière de la sélection
Selection.Cells(1, 1).EntireRow.Select

'On redimensionne du nombre de lignes choisies et on se place une ligne en dessous (.Rows(NbLignes_a + 1) )
'On redimensionne encore pour insérer le bon nombre de lignes
Selection.Resize(rowsize:=NbLignes_a).Rows(NbLignes_a + 1).EntireRow. _
Resize(rowsize:=NbLignes).Insert Shift:=xlDown

'On décale la selection
Selection.Offset(NbLignes - 1).EntireRow.Select

'"Autofill" à partir de la dernière ligne de la sélection pour recopier valeurs, formules et formats
Selection.AutoFill Selection.Resize(rowsize:=NbLignes + 1), xlFillDefault

On Error Resume Next
'On efface les constantes sous la dernière ligne de la sélection
Selection.Offset(1).Resize(NbLignes).EntireRow.SpecialCells(xlConstants).ClearContents

Else ' une seule ligne choisie
NbLignes_a = 2
ActiveCell.EntireRow.Select
Selection.Resize(rowsize:=NbLignes_a).Rows(NbLignes_a).EntireRow. _
Resize(rowsize:=NbLignes).Insert Shift:=xlDown

Selection.AutoFill Selection.Resize(rowsize:=NbLignes + 1), xlFillDefault

On Error Resume Next
Selection.Offset(1).Resize(NbLignes).EntireRow.SpecialCells(xlConstants).ClearContents

End If

Cells(Selection.Row + 1, SelCol).Select 'pour se replacer
Application.ScreenUpdating = True

End Sub


Merci d'avance pour votre aide.

Nicolas

 

[Paf]

Re : Copie d'une ligne et insertion des données copiées à la ligne suivante

Bonjour et bienvenu sur XLD

a priori:

Private Sub Workbook_Open()
 Dim i As Long
 With Worksheets("Maraichage") '
 For i = .Range("A" & .Rows.Count).End(xlUp).Row To 6 Step -1 'pour chaque ligne de la dernière à 6
    If Len(.Cells(i, 7)) >= 1 Then
    .Rows(i).Copy
    .Rows(i).Insert Shift:=xlDown
     Application.CutCopyMode = False
    End If
 Next
 End With
End Sub

A copier dans la feuille de code de ThisWorkbook

A+

 

[nikxs360]

Re : Copie d'une ligne et insertion des données copiées à la ligne suivante

Bonjour Paf,

Merci pour votre réponse.
Malheureusement, cela ne fonctionne pas pour moi.

Il ne se passe rien. Je suis tout nouveau dans ce monde VBA Excel, je ne fais peut-être pas ce qu'il faut.

A+

 

[Paf]

Re : Copie d'une ligne et insertion des données copiées à la ligne suivante

re,

Où avez vous copier le code ?

A+

 

[nikxs360]

Re : Copie d'une ligne et insertion des données copiées à la ligne suivante

Re,

J'ai copié le code dans ThisWorkbook.

A+

 

[Paf]

Re : Copie d'une ligne et insertion des données copiées à la ligne suivante

re,

c'est curieux, le code fonctionne dans le classeur du post #1, après saisie de quelques caractères dans les cellules de la colonne G 'à partir de la ligne 6), puisque:

copier une ligne complète et de l'insérer dans la ligne suivante à condition qu'il y ait au moins 1 caractère dans la colonne G.

J'ai peut-être mal compris l'histoire de la colonne G?

A+

Nb : si le soucis persiste joignez le classeur dans lequel vous avez copier le code.