Insérer lignes parallèles avec formules

Résolu/Fermé
VIKI1102 Messages postés 25 Date d'inscription jeudi 2 avril 2020 Statut Membre Dernière intervention 16 mars 2022 - 20 nov. 2020 à 10:56
VIKI1102 Messages postés 25 Date d'inscription jeudi 2 avril 2020 Statut Membre Dernière intervention 16 mars 2022 - 8 déc. 2020 à 15:16
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
A voir également:

3 réponses

cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
20 nov. 2020 à 16:03
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à
0
VIKI1102 Messages postés 25 Date d'inscription jeudi 2 avril 2020 Statut Membre Dernière intervention 16 mars 2022
25 nov. 2020 à 10:21
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
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
25 nov. 2020 à 10:25
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à
0
VIKI1102 Messages postés 25 Date d'inscription jeudi 2 avril 2020 Statut Membre Dernière intervention 16 mars 2022
27 nov. 2020 à 11:18
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
0
cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024 728
27 nov. 2020 à 11:53
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
0
VIKI1102 Messages postés 25 Date d'inscription jeudi 2 avril 2020 Statut Membre Dernière intervention 16 mars 2022 > cs_Le Pivert Messages postés 7903 Date d'inscription jeudi 13 septembre 2007 Statut Contributeur Dernière intervention 11 mars 2024
8 déc. 2020 à 15:16
Merci à vous!
0