Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Ajout de lignes sur plusieurs feuilles XL97

Ajout de lignes sur plusieurs feuilles XL97

19 réponses
Avatar
Gastibelza
Bonsoir,

J'ai trouvé sur Exelabo une macro (j'en profite pour remercier son
auteur) qui permet sur une feuille de créer une nouvelle ligne qui ne
conserve que les formules :

Sub NouvelleLigneEnDessous()

Dim ZtNumLig As Integer
Dim ZtDerCol As Integer

ActiveCell.Range("A2").EntireRow.Insert
ZtNumLig = ActiveCell.Row
ZtDerCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
Range(Cells(ZtNumLig, 1), Cells(ZtNumLig, ZtDerCol)).Copy _
Range(Cells(ZtNumLig + 1, 1), Cells(ZtNumLig + 1, ZtDerCol))
Application.ScreenUpdating = False
For i = 1 To ZtDerCol
If Not Cells(ZtNumLig + 1, i).HasFormula Then
Cells(ZtNumLig + 1, i).ClearContents
End If
Next i
ActiveCell.Range("A2").Select

End Sub

Cette procédure ne s'applique malheureusement qu'à la feuille active.
Ce que j'aimerais faire mais je n'y arrive pas, c'est que cette
procédure s'applique automatiquement à l'ensemble des feuilles de mon
classeur... et puis... si c'est pas trop demander, qu'elle crée la
nouvelle ligne juste après la dernière ligne contenant des données sans
tenir compte de la cellule sélectionnée... mais bon ce dernier point
n'est pas important, je peux me débrouiller sans.

Merci d'avance pour toutes vos idées.

--
Amicalement,

Laurent
Signaler un problème avec ce contenu

9 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
...Patrick
tu peux toujours afficher tout le code ici, on se penchera dessus ciomme une
maman sur son nouveau né :-))


Patrick


"Gastibelza" a écrit dans le message de
news:
...Patrick avait soumis l'idée :

et si tu rajoutais une boucle au début: (sous le sub)
sub .....

for each worksheet in activeworkbook

ton code ici

'sur le end sub

next
end sub


Merci pour ta réponse, çà semblerait logique mais ça ne marche pas :-(
J'obtiens une erreur d'exécution 438 : propriété ou méthode non gérée.
En mode débogage, lorsque je pointe le curseur sur le mot worksheet,
une infobulle me dit worksheet=vide
Si tu vois d'où peut venir le problème... en dehors de la position
située entre la chaise et le clavier ;o)

--
Amicalement,

Laurent



Avatar
Gastibelza

tu peux toujours afficher tout le code ici, on se penchera dessus ciomme une
maman sur son nouveau né :-)


Ben le voilà, mais je n'ai rajouté que la boucle (pas eu encore le
temps de regarder pour la seconde partie) et ça ne fonctionne pas, le
débogueur s'arrête sur la 1ere ligne du code après les déclarations des
variables avec l'erreur mentionnée plus haut.

Sub NouvelleLigneEnDessous()

Dim ZtNumLig As Integer
Dim ZtDerCol As Integer
For Each Worksheet In ActiveWorkbook
ActiveCell.Range("A2").EntireRow.Insert
ZtNumLig = ActiveCell.Row
ZtDerCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
Range(Cells(ZtNumLig, 1), Cells(ZtNumLig, ZtDerCol)).Copy _
Range(Cells(ZtNumLig + 1, 1), Cells(ZtNumLig + 1, ZtDerCol))
Application.ScreenUpdating = False
For i = 1 To ZtDerCol
If Not Cells(ZtNumLig + 1, i).HasFormula Then
Cells(ZtNumLig + 1, i).ClearContents
End If
Next i
ActiveCell.Range("A2").Select
Next
End Sub

Merci d'avance pour qui voudra me donner la gougoutte ;-)

--
Amicalement,

Laurent

Avatar
Gastibelza
sabatier a émis l'idée suivante :

encore que chez nous, dans le beaujolais, ce serait plutôt le PEUCWBIK...
Problem Exists Under Chair With Bottle Instead Keyboard...


On ne doit pas habiter le même Beaujolais... chez moi l'ordinateur
n'est pas à la cave :-Z

--
Amicalement,

Laurent

Avatar
...Patrick
j'ai change ceci et pas de plantage ..
mais je n'ai pas observé ce que le code fait :-))

Dim oSheet
For Each oSheet In ActiveWorkbook.Worksheets


...Patrick

Bon travail

"Gastibelza" a écrit dans le message de
news:

tu peux toujours afficher tout le code ici, on se penchera dessus ciomme
une


maman sur son nouveau né :-)


Ben le voilà, mais je n'ai rajouté que la boucle (pas eu encore le
temps de regarder pour la seconde partie) et ça ne fonctionne pas, le
débogueur s'arrête sur la 1ere ligne du code après les déclarations des
variables avec l'erreur mentionnée plus haut.

Sub NouvelleLigneEnDessous()

Dim ZtNumLig As Integer
Dim ZtDerCol As Integer
For Each Worksheet In ActiveWorkbook
ActiveCell.Range("A2").EntireRow.Insert
ZtNumLig = ActiveCell.Row
ZtDerCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
Range(Cells(ZtNumLig, 1), Cells(ZtNumLig, ZtDerCol)).Copy _
Range(Cells(ZtNumLig + 1, 1), Cells(ZtNumLig + 1, ZtDerCol))
Application.ScreenUpdating = False
For i = 1 To ZtDerCol
If Not Cells(ZtNumLig + 1, i).HasFormula Then
Cells(ZtNumLig + 1, i).ClearContents
End If
Next i
ActiveCell.Range("A2").Select
Next
End Sub

Merci d'avance pour qui voudra me donner la gougoutte ;-)

--
Amicalement,

Laurent



Avatar
Gastibelza
Gastibelza avait énoncé :

mais je n'ai rajouté que la boucle (pas eu encore le temps de regarder pour
la seconde partie)


Le tableau commençant à la CL A6 et la colonne A étant obligatoirement
servie, la ligne de code suivante a suffit :

Range("A6").End(xlDown).Offset(0, 0).Activate

Donc pour récapituler :
le code ci-après fonctionne mais ne s'applique que sur la feuille
active (même si toutes les feuilles ont été préalablement sélectionnées
à la souris)

Sub NouvelleLigneEnDessous()

Dim ZtNumLig As Integer
Dim ZtDerCol As Integer
Range("A6").End(xlDown).Offset(0, 0).Activate
ActiveCell.Range("A2").EntireRow.Insert
ZtNumLig = ActiveCell.Row
ZtDerCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
Range(Cells(ZtNumLig, 1), Cells(ZtNumLig, ZtDerCol)).Copy _
Range(Cells(ZtNumLig + 1, 1), Cells(ZtNumLig + 1, ZtDerCol))
Application.ScreenUpdating = False
For i = 1 To ZtDerCol
If Not Cells(ZtNumLig + 1, i).HasFormula Then
Cells(ZtNumLig + 1, i).ClearContents
End If
Next i
ActiveCell.Range("A2").Select
End Sub

Et le code ci-après ne fonctionne pas :

Sub NouvelleLigneEnDessous()

Dim ZtNumLig As Integer
Dim ZtDerCol As Integer
For Each Worksheet In ActiveWorkbook
Range("A6").End(xlDown).Offset(0, 0).Activate
ActiveCell.Range("A2").EntireRow.Insert
ZtNumLig = ActiveCell.Row
ZtDerCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
Range(Cells(ZtNumLig, 1), Cells(ZtNumLig, ZtDerCol)).Copy _
Range(Cells(ZtNumLig + 1, 1), Cells(ZtNumLig + 1, ZtDerCol))
Application.ScreenUpdating = False
For i = 1 To ZtDerCol
If Not Cells(ZtNumLig + 1, i).HasFormula Then
Cells(ZtNumLig + 1, i).ClearContents
End If
Next i
ActiveCell.Range("A2").Select
Next
End Sub

--
Amicalement,

Laurent

Avatar
...Patrick
tu as lu ma phrase for each .... ?



Dim oSheet
For Each oSheet In ActiveWorkbook.Worksheets


:-)


"Gastibelza" a écrit dans le message de
news:
Gastibelza avait énoncé :

mais je n'ai rajouté que la boucle (pas eu encore le temps de regarder
pour


la seconde partie)


Le tableau commençant à la CL A6 et la colonne A étant obligatoirement
servie, la ligne de code suivante a suffit :

Range("A6").End(xlDown).Offset(0, 0).Activate

Donc pour récapituler :
le code ci-après fonctionne mais ne s'applique que sur la feuille
active (même si toutes les feuilles ont été préalablement sélectionnées
à la souris)

Sub NouvelleLigneEnDessous()

Dim ZtNumLig As Integer
Dim ZtDerCol As Integer
Range("A6").End(xlDown).Offset(0, 0).Activate
ActiveCell.Range("A2").EntireRow.Insert
ZtNumLig = ActiveCell.Row
ZtDerCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
Range(Cells(ZtNumLig, 1), Cells(ZtNumLig, ZtDerCol)).Copy _
Range(Cells(ZtNumLig + 1, 1), Cells(ZtNumLig + 1, ZtDerCol))
Application.ScreenUpdating = False
For i = 1 To ZtDerCol
If Not Cells(ZtNumLig + 1, i).HasFormula Then
Cells(ZtNumLig + 1, i).ClearContents
End If
Next i
ActiveCell.Range("A2").Select
End Sub

Et le code ci-après ne fonctionne pas :

Sub NouvelleLigneEnDessous()

Dim ZtNumLig As Integer
Dim ZtDerCol As Integer
For Each Worksheet In ActiveWorkbook
Range("A6").End(xlDown).Offset(0, 0).Activate
ActiveCell.Range("A2").EntireRow.Insert
ZtNumLig = ActiveCell.Row
ZtDerCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
Range(Cells(ZtNumLig, 1), Cells(ZtNumLig, ZtDerCol)).Copy _
Range(Cells(ZtNumLig + 1, 1), Cells(ZtNumLig + 1, ZtDerCol))
Application.ScreenUpdating = False
For i = 1 To ZtDerCol
If Not Cells(ZtNumLig + 1, i).HasFormula Then
Cells(ZtNumLig + 1, i).ClearContents
End If
Next i
ActiveCell.Range("A2").Select
Next
End Sub

--
Amicalement,

Laurent



Avatar
Gastibelza

j'ai change ceci et pas de plantage ..


Effectivement, pas de plantage.

mais je n'ai pas observé ce que le code fait :-)


Il rajoute 14 lignes (j'ai 14 feuilles) uniquement dans la feuille
active et rien dans les autres feuilles :'(

--
Amicalement,

Laurent

Avatar
Frédéric Sigonneau
Bonsoir,

Il faudrait sans doute préciser un peu plus quels objets sont manipulés. Essaye
avec ces modifications du code (non testées) :

Sub NouvelleLigneEnDessous()
Dim ZtNumLig As Integer
Dim ZtDerCol As Integer
Dim sht As Worksheet

For Each sht In ActiveWorkbook.Sheets
sht.Activate
sht.Range("A6").End(xlDown).Offset(0, 0).Activate
ActiveCell.Range("A2").EntireRow.Insert
ZtNumLig = ActiveCell.Row
ZtDerCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
Range(Cells(ZtNumLig, 1), Cells(ZtNumLig, ZtDerCol)).Copy _
Range(Cells(ZtNumLig + 1, 1), Cells(ZtNumLig + 1, ZtDerCol))
For i = 1 To ZtDerCol
If Not Cells(ZtNumLig + 1, i).HasFormula Then
Cells(ZtNumLig + 1, i).ClearContents
End If
Next i
ActiveCell.Range("A2").Select
Next sht

End Sub

FS
---
Frédéric Sigonneau [MVP Excel - né un sans-culottide]
Gestions de temps, VBA pour Excel :
http://perso.wanadoo.fr/frederic.sigonneau
Si votre question sur Excel est urgente, évitez ma bal !

Gastibelza avait énoncé :

mais je n'ai rajouté que la boucle (pas eu encore le temps de regarder
pour la seconde partie)



Le tableau commençant à la CL A6 et la colonne A étant obligatoirement
servie, la ligne de code suivante a suffit :

Range("A6").End(xlDown).Offset(0, 0).Activate

Donc pour récapituler :
le code ci-après fonctionne mais ne s'applique que sur la feuille active
(même si toutes les feuilles ont été préalablement sélectionnées à la
souris)

Sub NouvelleLigneEnDessous()

Dim ZtNumLig As Integer
Dim ZtDerCol As Integer
Range("A6").End(xlDown).Offset(0, 0).Activate
ActiveCell.Range("A2").EntireRow.Insert
ZtNumLig = ActiveCell.Row
ZtDerCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
Range(Cells(ZtNumLig, 1), Cells(ZtNumLig, ZtDerCol)).Copy _
Range(Cells(ZtNumLig + 1, 1), Cells(ZtNumLig + 1, ZtDerCol))
Application.ScreenUpdating = False
For i = 1 To ZtDerCol
If Not Cells(ZtNumLig + 1, i).HasFormula Then
Cells(ZtNumLig + 1, i).ClearContents
End If
Next i
ActiveCell.Range("A2").Select
End Sub

Et le code ci-après ne fonctionne pas :

Sub NouvelleLigneEnDessous()

Dim ZtNumLig As Integer
Dim ZtDerCol As Integer
For Each Worksheet In ActiveWorkbook
Range("A6").End(xlDown).Offset(0, 0).Activate
ActiveCell.Range("A2").EntireRow.Insert
ZtNumLig = ActiveCell.Row
ZtDerCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
Range(Cells(ZtNumLig, 1), Cells(ZtNumLig, ZtDerCol)).Copy _
Range(Cells(ZtNumLig + 1, 1), Cells(ZtNumLig + 1, ZtDerCol))
Application.ScreenUpdating = False
For i = 1 To ZtDerCol
If Not Cells(ZtNumLig + 1, i).HasFormula Then
Cells(ZtNumLig + 1, i).ClearContents
End If
Next i
ActiveCell.Range("A2").Select
Next
End Sub




Avatar
Gastibelza
Frédéric Sigonneau a présenté l'énoncé suivant :

Bonsoir,


Bonsoir,

Il faudrait sans doute préciser un peu plus quels objets sont manipulés.
Essaye avec ces modifications du code (non testées) :


Mille mercis Monsieur Sigonneau !!! Le code que tu donnes fonctionne
parfaitement. Il fait même exactement ce que je recherchais après avoir
rajouté 3 lignes pour revenir sur la feuille qui était active au moment
du lancement de la macro (code en dessous).

Je te renouvelle mes remerciements :-)


Public Sub nouvelleligne()
Dim ZtNumLig As Integer
Dim ZtDerCol As Integer
Dim sht As Worksheet
Dim FeuilleActive As String
FeuilleActive = ActiveSheet.Name
For Each sht In ActiveWorkbook.Sheets
sht.Activate
sht.Range("A6").End(xlDown).Offset(0, 0).Activate
ActiveCell.Range("A2").EntireRow.Insert
ZtNumLig = ActiveCell.Row
ZtDerCol = ActiveCell.SpecialCells(xlCellTypeLastCell).Column
Range(Cells(ZtNumLig, 1), Cells(ZtNumLig, ZtDerCol)).Copy _
Range(Cells(ZtNumLig + 1, 1), Cells(ZtNumLig + 1, ZtDerCol))
For i = 1 To ZtDerCol
If Not Cells(ZtNumLig + 1, i).HasFormula Then
Cells(ZtNumLig + 1, i).ClearContents
End If
Next i
ActiveCell.Range("A2").Select
Next sht
Sheets(FeuilleActive).Activate
End Sub

--
Amicalement,

Laurent

1 2