Macro - Comprendre pourquoi sa fonctionne pas ?

[Rapheux]

Bonjour,

Depuis quelques jours je travail sur une macro, qui me permet de rajouté des lignes dans un tableau avec copie de formule.

Je vais commencer par vous présenter mon code, puis je vous expliquerais mes attentes et enfin mes résultats pour mieux vous aidé ... à m'aidé si possible ! Je vous remercie de m'avoir jusqu'à là déjà !

1) Mon code :

Sub Ligne_add()

Dim nb_ligne As Long
Dim nb_col As Long
nb_ligne = ActiveSheet.UsedRange.Rows.Count
nb_col = ActiveSheet.UsedRange.Columns.Count
Range("A1").Select
For i = 1 To nb_col
Cells(nb_ligne + 1, i).Formula = Cells(4, i).Formula
Next
End Sub

2) Mes attentes :

- Insérer une ligne en dessous de la dernière
- Copier les formules de la ligne mère (en ligne 4) SANS les valeurs dans la nouvel ligne (et en essayant de garder les bordures).
- J'aimerais que la mise à jour de la formule soit dynamique (cad par exemple: en ligne mère j'ai H4*R4, il faut quand je rajoute ma ligne si c'est la ligne 62, que sa me fasse H62*R62)

3) Mes résultats :
- La ligne est bien crée
- Les données dans la nouvel ligne sont les valeurs de la ligne mère, et non juste les formules.
- Je perd la mise en forme de la ligne mère (cad : les bordures disparaissent)

Avez-vous une idée de comment résoudre mon problème et je pense, avoir une solution pour un codage plus élégant ?

Cordialement,
Rapheux

 

[ILoveZadig]

Re : Macro - Comprendre pourquoi sa fonctionne pas ?

Bonjour Rapheux,

Voici un code pour ajouter une ligne en dessous de la dernière ligne renseignée :

Sub Insertion()
derlig = Range("A1").End(xlDown).Row + 1        'Recherche première ligne vide
Rows(derlig).Select
Selection.Insert Shift:=xlDown                'Insertion à la première ligne vide

End Sub

Pour la mise en forme, tu n'as plus qu'à placer avec au pire l'enregistreur de macro, pour encadrer les lignes ajoutées. J'ai par exemple (à améliorer) :

ActiveCell.Offset(-1, 0).Rows("1:1").EntireRow.Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Rows("1:1").EntireRow.Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    ActiveCell.Offset(-1, 0).Range("A1:D1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    ActiveCell.Offset(-1, 3).Range("A1:B1").Select
    Selection.Copy
    ActiveCell.Offset(1, 0).Range("A1").Select
    ActiveSheet.Paste
    ActiveCell.Offset(-2, 0).Range("A1").Select
    Application.CutCopyMode = False
    
    ActiveCell.Offset(1, -3).Range("A1:D1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With

Bon courage

 

[nolich]

Re : Macro - Comprendre pourquoi sa fonctionne pas ?

Bonjour Rapheux et ILoveZadig, bonjour à toutes et à tous

Je te propose ce code (non testé) :

Sub Ligne_add()
'
Dim nb_ligne As Long
'
  nb_ligne = ActiveSheet.UsedRange.Rows.Count + 1

  Rows(4).Copy Rows(nb_ligne)
  Rows(nb_ligne).SpecialCells(xlCellTypeConstants).ClearContents
End Sub

@+

 

[Rapheux]

Re : Macro - Comprendre pourquoi sa fonctionne pas ?

Wouaaaaa ! Merci merci merci !

Sa fonctionne exactement comme je le désire !

J'ai plus qu'à rajouté une petite boucle pour que cela se fasse sur l'ensemble des feuilles dont j'ai besoin

 

[Rapheux]

Re : Macro - Comprendre pourquoi sa fonctionne pas ?

Je reviens vers vous car j'ai un léger bug !

Sub Ligne_add()
Dim nb_ligne As Long
For x = 1 To 5
Worksheets(x).Activate
nb_ligne = ActiveSheet.UsedRange.Rows.Count + 1
  Rows(4).Copy Rows(nb_ligne)
  Rows(nb_ligne).SpecialCells(xlCellTypeConstants).ClearContents
Next
  
Worksheets("Information Client").Activate
Range("A1").Select
End Sub

Le for x=1 to 5, c'est simplement par ce que j'ai besoin de répété la macro sur les 5 première feuilles seulement !

Alors le petits bug que j'ai :
- Si sur une des feuilles, la macro tente de copié une cellule contenant une liste et/ou une formule vide (cad : ma cellule est vide car pas d'item de la liste choisie ou bien la cellule contenant la formule est vide car les références a la formules ne sont pas encore indiqués), la macro se stop en débogage sur la ligne :

Rows(nb_ligne).SpecialCells(xlCellTypeConstants).ClearContents

Hors, le problème, c'est que ma feuille 5, est un tableau qui compile toute les infos des feuilles précédente sous forme :

A1 Feuille1!A1
b1 Feuille1!A2
...
Q1 Feuille2!A1
...
AA1 Feuille3!A1
...

du coup, j'ai l'impression que la macro buggra tout le temps sur la feuille 5 car je ne peux renseigner à l'avance les cellules de la feuille 5.

J'espère être claire (je ne peux envoyer mon tableau, je suis derrière un pare feux).

Je reste à votre écoute si besoin de plus d'info

 

[nolich]

Re : Macro - Comprendre pourquoi sa fonctionne pas ?

Re

Alors le petits bug que j'ai :
- Si sur une des feuilles, la macro tente de copié une cellule contenant une liste et/ou une formule vide (cad : ma cellule est vide car pas d'item de la liste choisie ou bien la cellule contenant la formule est vide car les références a la formules ne sont pas encore indiqués), la macro se stop en débogage sur la ligne :

Rows(nb_ligne).SpecialCells(xlCellTypeConstants).ClearContents

Quel est le message d'erreur du debugger lorsque ça stoppe ?

@+

 

[Rapheux]

Re : Macro - Comprendre pourquoi sa fonctionne pas ?

Erreur d'éxécution '1004':

Pas de cellules correspondantes

 

[nolich]

Re : Macro - Comprendre pourquoi sa fonctionne pas ?

Re

Erreur d'éxécution '1004':

Pas de cellules correspondantes

Si ce n'est que cela, tu peux le contourner en ajoutant une instruction On Error ainsi :

Sub Ligne_add()
Dim nb_ligne As Long
For x = 1 To 5
Worksheets(x).Activate
nb_ligne = ActiveSheet.UsedRange.Rows.Count + 1
  Rows(4).Copy Rows(nb_ligne)
  On Error Resume Next
  Rows(nb_ligne).SpecialCells(xlCellTypeConstants).ClearContents
  On Error GoTo 0
Next
  
Worksheets("Information Client").Activate
Range("A1").Select
End Sub

Tiens-nous au courant

@+

 

[Rapheux]

Re : Macro - Comprendre pourquoi sa fonctionne pas ?

Même problème !

Le On Error GoTo 0 n'a rien résolue !

 

[nolich]

Re : Macro - Comprendre pourquoi sa fonctionne pas ?

Et ceci ?

Sub Ligne_add()
Dim nb_ligne As Long
For x = 1 To 5
Worksheets(x).Activate
nb_ligne = ActiveSheet.UsedRange.Rows.Count + 1
  Rows(4).Copy Rows(nb_ligne)
  If x <> 5 Then
    Rows(nb_ligne).SpecialCells(xlCellTypeConstants).ClearContents
  End If
Next
  
Worksheets("Information Client").Activate
Range("A1").Select
End Sub

@+

 

[Rapheux]

Re : Macro - Comprendre pourquoi sa fonctionne pas ?

Je comprend plus rien !

Sur la feuille 1, feuille de départ ! la macro fonctionne correctement
sur la feuille 2, la macro fonctionne correctement

des que sa arrive sur la feuille 3 ! Arret - debogage

Erreur '1004'

Pas de cellules correspondantes !

Je suis paumé !

Les feuilles 1 à 4 sont identiques dans leurs structures, donc je comprend pas pourquoi sa fonctionne que pour la moitié des feuilles

 

[Rapheux]

Re : Macro - Comprendre pourquoi sa fonctionne pas ?

Bon ! Après divers bidouillage, test, recherche, ... et doliprane !

Je sait d'où viens l'erreur, maisje sait pas l'expliquer !

En retirant simplement : Rows(nb_ligne).SpecialCells(xlCellTypeConstants).ClearContents

je n'ai plus de bug ! Par contre je n'efface plus les donnée de la nouvelle ligne.

Je pense qu'il doit y avoir un problème quand il tente d'éffacer le contenu spécial d'une des cellules.

 

[nolich]

Re : Macro - Comprendre pourquoi sa fonctionne pas ?

Re Rapheux

Alors on essaie de faire un mix des 2 manières de coder :

Sub Ligne_add()
'
Dim nbLigne As Long
Dim nbCol As Long
Dim x As Long, i As Integer
'
  
  On Error Resume Next
  
  For x = 1 To 5
    Worksheets(x).Activate
    nbLigne = ActiveSheet.UsedRange.Rows.Count + 1
    nbCol = ActiveSheet.UsedRange.Columns.Count
    
    Rows(4).Copy Rows(nb_ligne)
    Rows(nb_ligne).SpecialCells(xlCellTypeConstants).ClearContents
    
    If Err.Number <> 0 Then
      Err.Clear
      
      For i = 1 To nbCol
        If Not Cells(nbLigne, nbCol).HasFormula Then
          Cells(nbLigne, [B][COLOR="Red"]i[/COLOR][/B]).ClearContents
        End
      Next i
      
    End If
    
  Next x
  
  Worksheets("Information Client").Activate
  Range("A1").Select
End Sub

Tiens-nous au courant

Don't worry... Be happy

@+

 

[nolich]

Re : Macro - Comprendre pourquoi sa fonctionne pas ?

Re

Petite correction dans le code :

For i = 1 To nbCol
If Not Cells(nbLigne, i).HasFormula Then
Cells(nbLigne, i).ClearContents
End If
Next i

Voili voilà

@+

 

[Rapheux]

Re : Macro - Comprendre pourquoi sa fonctionne pas ?

Je test sa dans la journée !

Mais j'ai constaté un problème dans la continuité de mon projet ! En utilisant ce morceaux de code, pour insérer des lignes, je casse mes liste dynamique que j'utilise pour faire des extractions à la semaine.

Quand je fait NB.SI(Ma_Liste;C1) par exemple ! Les nouvelles cellules entrées par la macro d'insertion ne sont pas intégré dans la liste dynamique. Juste pour info je déclare mes liste dynamique comme suit :
=DECALER(feuille1!$A$2;;;NBVAL(Feuille1!$A:$A)-1;1)

et donc les nouvelles entrées ne sont pas inséré ! Je ne comprend pas pourquoi ? Faut je regarde sa de plus pret, si quelqu'un à une explication et/ou une solution. Je ne peux poster mon fichiers mais si vous m'envoyer un message je peux vous le faire parvenir par mail.