Insérer lignes parallèles avec formules

Signaler
Messages postés
10
Date d'inscription
jeudi 2 avril 2020
Statut
Membre
Dernière intervention
27 novembre 2020
-
Messages postés
7095
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
27 novembre 2020
-
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

3 réponses

Messages postés
7095
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
27 novembre 2020
579
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à
Messages postés
10
Date d'inscription
jeudi 2 avril 2020
Statut
Membre
Dernière intervention
27 novembre 2020

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
Messages postés
7095
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
27 novembre 2020
579
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à
Messages postés
10
Date d'inscription
jeudi 2 avril 2020
Statut
Membre
Dernière intervention
27 novembre 2020

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
Messages postés
7095
Date d'inscription
jeudi 13 septembre 2007
Statut
Contributeur
Dernière intervention
27 novembre 2020
579
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