Discussion :

[Gordongekko]

Salut,

je travail sur un projet sur excel et je désire utiliser une macros pour le faire. mon problème consiste a ajouter une ligne en fin de tableau excel avec une vba pour construire ma base de donner, par fin de tableau je veux dire insérer une ligne en dessous de la dernière utilisé selon ces conditions respectivement:
stat.xlsm
1- copier les lignes 6,7,8,9 avec les formules et la mise en forme
2- insérer une ligne en fin de tableau a chaque fois que je clique sur le bouton pour coller les lignes précédentes
3- coller les lignes 6,7,8,9 sous la dernière ligne occuper
4- modifier la date via la fonction aujourd'hui dans la colonne C
5- supprimer les 8 données dans les colonnes E et F (4 dans E et 4 dans F pour chaque date) pour saisie manuelle ultérieurement
6- insérer une commande pour ôter+protéger la feuille lorsque je clique sur le bouton tout en me permettant de saisir les données dans les colonnes E et F manuellement

ci-joint le fichier dont la macros ne fonctionne pas malheureusementstat.xlsm

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 
Sub Macro1()
'
' Macro1 Macro
'
 
'
    ActiveWindow.SmallScroll Down:=12
    Range("B22:M25").Select
    Selection.Copy
    Range("B26").Select
    ActiveSheet.Paste
    Range("C26").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Range("C26").Select
    Selection.AutoFill Destination:=Range("C26:C29"), Type:=xlFillDefault
    Range("C26:C29").Select
    Range("C22:C25").Select
    Selection.Copy
    Range("C26:C29").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("E26:F29").Select
    Selection.ClearContents
    Range("E26").Select
End Sub

[Nicolas JACQUIN]

Bonjour et bienvenue sur le forum
A tester

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Macro1()
ActiveSheet.Unprotect
Dim derligne As Integer
Dim derlign As Integer
    derligne = Worksheets("Feuil3").Range("B65536").End(xlUp).Row
Range("B6:M9").Copy
Sheets("Feuil3").Range("B" & derligne + 2).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    derlign = Worksheets("Feuil3").Range("C65536").End(xlUp).Row
Range("C" & derlign & ":C" & derlign - 4).Value = Date
Range("E" & derlign - 3 & ":F" & derlign).ClearContents
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

A bientôt

[Gordongekko]

Bonjour Nicolas,

Vraiment 1000 merci ça fonctionne à merveille vraiment tous comme désirer. je viens de découvrir l'utilité des macros récemment vu que je passé des heures a faire plusieurs taches respectives alors que maintenant 5 minutes max et en cliquant sur un seul boutant. ça me rend la vie plus facile comme vous dites en France

Pouvez vous please me dire ou je me suis trompé dans ma macro enregistrée automatiquement? et une dernière demande, pretty please, lorsque je protégé la feuille je veux avoir la possibilité de saisie manuelle dans les 8 cellules sans pour autant ôter la protection de la feuille (genre une commande spécial)

est cela est possible?

[Nicolas JACQUIN]

L'enregistreur enregistre vos actions, après il faut affiner, parce qu'il ne peut pas deviner tous seule l'emplacement ou vous souhaitez vos enregistrement.
si ça répond à votre question

sinon pour ce qui est de la protection, je suis pas doué, je ne sais pas.

[Gordongekko]

I've just found the solution mate j'ai juste selectionner la feuille et verrouillé que les cellules voulus le reste ca marche

une remarque dear friend, pour cette ligne j'ai changer -4 par -3 vu que j'ai remarquer que lorsqu'il change la date des cellules copié il modifie aussi celle de la dernière ligne. je pense que c'est bon non

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("C" & derlign & ":C" & derlign - 4).Value = Date

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
ub ADD()
'
' ADD Macro
'
ActiveSheet.Unprotect 
Dim derligne As Integer
Dim derlign As Integer
    derligne = Worksheets("BCTX KEYS").Range("B65536").End(xlUp).Row
Range("B606:M609").Copy
Sheets("BCTX KEYS").Range("B" & derligne + 2).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    derlign = Worksheets("BCTX KEYS").Range("C65536").End(xlUp).Row
Range("C" & derlign & ":C" & derlign - 3).Value = Date
Range("E" & derlign - 3 & ":F" & derlign).ClearContents
ActiveSheet.protect 
'
End Sub

[Gordongekko]

Salut cher Nicolas,

je reviens vers vous pour vous demandez une autre aide svp. c'est le même principe que l'autre fois avec des copier/coller + ajouter des lignes au dessous de la dernière ligne occupée en changeant la date d'aujourd'hui puis recueillir des données d'une autres feuilles et les collés juste chiffre pas de formule.

je vous présente ma macros qui n'a pas fonctionné du tout.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
    Workbooks.Open Filename:= _
        "C:\Users\mega-pc\Desktop\MACROS EXCEL\STAT BBE.xlsx", UpdateLinks:=3
 
        Dim derligne As Integer
        Dim derlign As Integer
        derligne = Worksheets("Feuil1").Range("B65536").End(xlUp).Row
        Range("B7:V10").Copy
        Sheets("Feuil1").Range("B" & derligne + 2).PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
    derlign = Worksheets("Feuil1").Range("C65536").End(xlUp).Row
Range("B" & derlign & ":C" & derlign - 4).Value = Date
End Sub