Recopie de formule incrementé et mise en forme cellule

Bonjour à tous, je suis nouveau sur le forum et apprécie grandement ce que vous faites!

Je suis tout nouveau dans le monde du vba et j'éprouve certaines petites difficultés, et j'espère que vous saurez m'éclairer.

Mon besoin est le suivant:

j'ai crée un bouton insertion de ligne qui créer le nombre de ligne désiré à un endroit donné, qui est la ligne précédent mon total.

J'aurais en outre besoin que cela rajoute la copie incrémenté de la formule conditionnelle comprise dans la colonne d, mais aussi que cela conserve ma mise en forme (bordure et trame).

j'ai fait un essaie mais peu concluant qui ne fait la recopie incrementé et la mise en forme que sur une seule ligne. et non sur le nombre de ligne créer.

voici la copie de ma macro de recopie de ligne juste avant mon total

Sub Insertion_par_fonction_find()
    Dim message As String, title As String
    Dim nblg As Byte
    message = "Entrez le nombre de lignes"
    title = "Insérer lignes"
    nblg = Application.InputBox(message, title, Type:=1)
    If nblg = 0 Then MsgBox "Le nombre de lignes est à zéro": End
    Dim derlign As Long
    Dim trouve As Range
    derlign = Range("B" & Rows.Count).End(xlUp).Row 'trouve la dernière ligne de la colonne B
    Set trouve = Range("B2:B" & derlign).Find("TOTAL", lookAt:=xlWhole) 'on utilise la méthode Find pour chercher "TOTAL" dans la colonne B
    If Not trouve Is Nothing Then Rows(trouve.Row).Resize(nblg, 1).EntireRow.Insert Shift:=xlDown
    End Sub

avec impatience de comprendre comment et pourquoi! !

Bonjour,

Ton classeur est bloquer, probablement à cause des liaisons et de ton bouton qui appel une macro dans un autre classeur..

J'ai tester sur un nouveau classeur et ça a l'air de fonctionner.

Sub Insertion_par_fonction_find()
Dim DerLign As Long
Dim NbLg As Byte
    NbLg = Application.InputBox("Entrez le nombre de lignes", "Insérer lignes", Type:=1)
    If NbLg = 0 Then MsgBox "Le nombre de lignes est à zéro": Exit Sub 'End pas bon
    DerLign = Range("B" & Rows.Count).End(xlUp).Row - 1 'trouve la ligne de la colonne B juste avant TOTAL
    Rows(DerLign & ":" & DerLign + NbLg - 1).Insert
    Rows(DerLign + NbLg).Copy Rows(DerLign)
    Rows(DerLign + NbLg).ClearContents
    Range("D" & DerLign).Copy Range(Cells(DerLign + 1, "D"), Cells(DerLign + NbLg, "D"))
    Range("K" & DerLign).Copy Range(Cells(DerLign + 1, "K"), Cells(DerLign + NbLg, "K"))
End Sub

A tester.

A+

DSL, je suis allé trop vite dans l'envoie du fichier en question!!!

alors un grand MERCI.... j'ai testé et je valide, cela fonctionné effectivement il suffit de rajouter l’incrémentation dans la ligne de code!!

ca a l'air bête comme ca, mais cela ne fait que quelques jours que je m'y suis mis!!

J'ai rajouté a cela 2 colonnes supplémentaires a recopier, voici le code :

    Sub Insertion_par_fonction_find()
    Dim DerLign As Long
    Dim NbLg As Byte
        NbLg = Application.InputBox("Entrez le nombre de lignes", "Insérer lignes", Type:=1)
        If NbLg = 0 Then MsgBox "Le nombre de lignes est à zéro": Exit Sub 
       DerLign = Range("B" & Rows.Count).End(xlUp).Row - 1 'trouve la ligne de la colonne B juste avant TOTAL
       Rows(DerLign & ":" & DerLign + NbLg - 1).Insert
        Rows(DerLign + NbLg).Copy Rows(DerLign)
        Rows(DerLign + NbLg).ClearContents
        Range("D" & DerLign).Copy Range(Cells(DerLign + 1, "D"), Cells(DerLign + NbLg, "D"))
        Range("K" & DerLign).Copy Range(Cells(DerLign + 1, "K"), Cells(DerLign + NbLg, "K"))
        Range("F" & DerLign).Copy Range(Cells(DerLign + 1, "F"), Cells(DerLign + NbLg, "F"))
        Range("M" & DerLign).Copy Range(Cells(DerLign + 1, "M"), Cells(DerLign + NbLg, "M"))
    End Sub

D'ailleur j'aurais voulu savoir s'il y avait un moyen pour pouvoir effectuer cette macro une fois la feuille protégé, car j'ai fait un essaie et si l'on décoche l'ajout de ligne par l'utilisateur, la macro elle non plus ne peut le faire....

Merci d'avance

Bonjour,

Ci-joint ma proposition avec une petite modification de mise en forme du tableau pour ne rien écrire sur l'avant dernière ligne.

Cela permet de garder le format des cellules.

Cordialement

Option Explicit
Sub Insertion_par_fonction_find()
'Macro Dan
Dim message As String, title As String
Dim nblg As Byte
Dim derlign As Long
Dim i As Byte

    message = "Entrez le nombre de lignes"
    title = "Insérer lignes"
    nblg = Application.InputBox(message, title, Type:=1)
    If nblg = 0 Then MsgBox "Le nombre de lignes est à zéro": End

    'trouve la dernière ligne de la colonne B
    derlign = Range("B" & Rows.Count).End(xlUp).Row
    For i = 1 To nblg
    Rows(derlign - 2).EntireRow.Insert Shift:=xlDown
    Next i

End Sub

 Sub Insertion_par_fonction_find()
    Dim DerLign As Long
    Dim NbLg As Byte
        NbLg = Application.InputBox("Entrez le nombre de lignes", "Insérer lignes", Type:=1)
        If NbLg = 0 Then MsgBox "Le nombre de lignes est à zéro": Exit Sub
        DerLign = Range("B" & Rows.Count).End(xlUp).Row - 1 'trouve la ligne de la colonne B juste avant TOTAL
        Sheets("Feuil1").Unprotect ("CodePasse")
        Rows(DerLign & ":" & DerLign + NbLg - 1).Insert
        Rows(DerLign + NbLg).Copy Rows(DerLign)
        Rows(DerLign + NbLg).ClearContents
        Range("D" & DerLign).Copy Range(Cells(DerLign + 1, "D"), Cells(DerLign + NbLg, "D"))
        Range("K" & DerLign).Copy Range(Cells(DerLign + 1, "K"), Cells(DerLign + NbLg, "K"))
        Range("F" & DerLign).Copy Range(Cells(DerLign + 1, "F"), Cells(DerLign + NbLg, "F"))
        Range("M" & DerLign).Copy Range(Cells(DerLign + 1, "M"), Cells(DerLign + NbLg, "M"))
        Sheets("Feuil1").Protect ("CodePasse")
    End Sub

Remplacer CodePasse par le mot de passe.

Si pas de code enlever ("CodePasse")

A+

Jean-Eric

merci a toi pour cette macro, j'ai testé c'est effectivement pratique, mais je ne veux ajouter ma ligne qu'avant la dernière pour éviter à l'utilisateur de décaler ses données, car cela est destiné à des personnes pas forcément connaisseuse d'excel!

Lermite

MERCI!!! cela fonctionne bien tel que je l'attendais

seulement ma macro concerne un certains nombres de feuilles (presque tout le classeur) de ce fait j'ai tenté Worksheets ainsi que Workbook, mais sans succés! je dois avoir mal compris quelque chose je crois

Dois je inscrire tous les noms de feuilles concernées ou bien est ce que je peux choisir tout le classeur directement??

[b]

RÉPONSE TROUVÉE[/b]

!!!!! un peu de réflexion et de recherche!!!

j'ai choisie la fonction ActiveSheet tout simplement.

Mais ma question reste entier, comment affecté un macro sur page protégé ; sur une plage de feuille?

Pour ceux qui sont intéressés :

macro 1 dé-protection, insertion et re-protection:

Sub Macro1()
ActiveSheet.Unprotect
ActiveCell.EntireRow.Insert Shift:=xlDown
ActiveSheet.Protect
End Sub

Autre solution (non testé par moi)

Par VBA, on peut aussi faire (au lancement du classeur dans l'évènement Workbook_Open) :

ActiveSheet.Protect Password:='motdepasse', AllowInsertingRows:=True

On peut également utiliser la protection de feuille par VBA toujours au lancement du classeur :

ActiveSheet.Protect Password:='motdepasse', UserInterfaceOnly:=True