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

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