Insérer lignes parallèles avec formules
Résolu
VIKI1102
Messages postés
30
Statut
Membre
-
VIKI1102 Messages postés 30 Statut Membre -
VIKI1102 Messages postés 30 Statut Membre -
Bonjour, j'espère trouver de l'aide concernant une macro que je tente de créer.
Je m'explique:
Mon fichier comporte 5 feuilles: Archives, 1, 2,3,4
Je souhaite insérer une ligne au même endroit de chaque feuille (sauf Archives) en recopiant les formules automatiquement et petite spécificité: j'ai besoin que dans la feuille 4 une deuxième ligne s'insère en même temps 305 lignes après la première insérée.
Je vous transmets ma macro bidouillée et qui ne marche pas bien sûr. Cette macro ne contient pas encore la recopie des formules du dessus (je n'ai pas réussis)
Merci par avance pour votre précieuse aide !
Sub InsérerLigne()
Dim Ligne As Long, F As Integer
Ligne = ActiveCell.Row
For F = 1 To F = 3
If Not (Sheets(F).Name = "Archives" Or Sheets(F).Name = "Archives") Then
Sheets(F).Rows(Ligne).Insert Shift:=xlDown
End If
Next F
When F = 4
Sheets(F).Rows(Ligne).Insert Shift:=xlDown
Sheets(F).Rows(Ligne).Insert Shift:=xlDown + 305
End Sub
Je m'explique:
Mon fichier comporte 5 feuilles: Archives, 1, 2,3,4
Je souhaite insérer une ligne au même endroit de chaque feuille (sauf Archives) en recopiant les formules automatiquement et petite spécificité: j'ai besoin que dans la feuille 4 une deuxième ligne s'insère en même temps 305 lignes après la première insérée.
Je vous transmets ma macro bidouillée et qui ne marche pas bien sûr. Cette macro ne contient pas encore la recopie des formules du dessus (je n'ai pas réussis)
Merci par avance pour votre précieuse aide !
Sub InsérerLigne()
Dim Ligne As Long, F As Integer
Ligne = ActiveCell.Row
For F = 1 To F = 3
If Not (Sheets(F).Name = "Archives" Or Sheets(F).Name = "Archives") Then
Sheets(F).Rows(Ligne).Insert Shift:=xlDown
End If
Next F
When F = 4
Sheets(F).Rows(Ligne).Insert Shift:=xlDown
Sheets(F).Rows(Ligne).Insert Shift:=xlDown + 305
End Sub
3 réponses
-
Bonjour,
comme ceci:
Option Explicit Sub InsérerLigne() Dim Ligne As Long, i As Integer Ligne = ActiveCell.Row Application.ScreenUpdating = False Dim Ws As Worksheet For Each Ws In ThisWorkbook.Worksheets If Ws.Name <> "Archives" Then Rows(Ligne & ":" & Ligne).Copy Sheets(Ws.Name).Rows(Ligne & ":" & Ligne).Insert Shift:=xlDown End If Next Ws Worksheets("Feuil4").Select ' adapter le nom de la feuille For i = Ligne To 305 Worksheets("Feuil4").Rows(i & ":" & i).Copy Worksheets("Feuil4").Rows(i & ":" & i).Insert Shift:=xlDown Next i Application.ScreenUpdating = True End Sub
Voilà
-
Bonjour !
je vous remercie pour votre retour !
la macro insère bien les lignes mais ne tire pas les formules de la lignes du dessus, auriez vous une solution svp?
De plus, j'ai mal exprimé mon souhait, je m'explique: j'aurais besoin d'insérer une ligne en plus dans la feuille 4 mais proportionnelle de 305 à celle que je viens d'insérer car j'ai deux tableaux l'un au dessus de l'autre et je voulais insérer une ligne dans chaque tableau au même endroit. Par exemple 1ère insertion à ligne 5 --> deuxième insertion à la ligne 305+5
Merci par avance ! bonne journée-
voir ceci pour copier les formules
https://docs.microsoft.com/fr-FR/office/vba/api/Excel.Range.Copy
Par exemple 1ère insertion à ligne 5 --> deuxième insertion à la ligne 305+5
il faut faire 2 fois la boucle, une qui démarre à la ligne 5 et l'autre à la ligne 305
Voilà
-
-
Merci beaucoup
mais je souhaite garder "Ligne = ActiveCell.Row" dans ma feuille 4 pour insérer au même endroit que dans les autres feuilles ET en plus insérer dans cette même feuille une nouvelle ligne 305 lignes après celle -ci
je suis désolée je tente de me former un peu au VBA mais je suis débutante, j'espère que vous comprenez ce que j'essais de faire XD-
essayer ceci:
Option Explicit Sub InsérerLigne() Dim Ligne As Long, i As Integer Ligne = ActiveCell.Row Application.ScreenUpdating = False Dim Ws As Worksheet For Each Ws In ThisWorkbook.Worksheets If Ws.Name <> "Archives" Then Sheets(Ws.Name).Rows(Ligne & ":" & Ligne).Insert Shift:=xlDown Worksheets("Archives").Range("A4:I4").Copy _ Destination:=Worksheets(Ws.Name).Range("A4") 'adapter la plage à copier "A4:I4" End If Next Ws Worksheets("Archives").Range("A4:I4").Copy _ Destination:=Worksheets("Feuil4").Range("A310") 'adapter la plage à copier "A4:I4" Application.ScreenUpdating = True End Sub
@+ Le Pivert
-
