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

[Nicolas JACQUIN]

Bonjour l'ami,

en reprenant le dernier code donné, remplace:

Code :

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

Paste:=xlPasteAllUsingSourceTheme

par

Code :

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

Paste:=xlPasteValues

et

Code :

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

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

par

Code :

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

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

Bonne continuation.

[Gordongekko]

Merci Nicolas,

ça marche bien malgré que jusqu’à mnt j'ignore la différence entre les deux méthodes (la mienne erronée et la votre la parfaite)

bref j'ai un autre probleme, aprés avoir ajouté votre code dans quelque cellules je désire faire une copier/coller de certains chiffres -seulement copier les valeur pas de mise en forme ni formule- qui se trouve dans le fichier initial "TEST.xls" vers ce nouveau fichier "STAT BBE.xlsx" j'ai essayer ça mais ça ne pas fonctionné malheureusement

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Sub STAT()
'
' STAT Macro
'
 
'
    ChDir "C:\Users\mega-pc\Desktop\MACROS EXCEL"
    Workbooks.Open Filename:= _
        "C:\Users\mega-pc\Desktop\MACROS EXCEL\STAT BBE.xlsx"
   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("C" & derlign - 3 & ":C" & derlign).Value = Date
Range("E" & derlign - 3 & ":F" & derlign).ClearContents
Windows("TEST.xls").Activate
Range("B73:C76").Select
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Range("H" & derlign - 3 & ":I" & derlign).ClearContents
Windows("TEST.xls").Activate
    Range("D73:E76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Range("K" & derlign - 3 & ":L" & derlign).ClearContents
Windows("TEST.xls").Activate
    Range("F73:G76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Range("N" & derlign - 3 & ":O" & derlign).ClearContents
Windows("TEST.xls").Activate
    Range("H73:I76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Range("Q" & derlign - 3 & ":R" & derlign).ClearContents
Windows("TEST.xls").Activate
    Range("J73:K76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Range("T" & derlign - 3 & ":U" & derlign).ClearContents
Windows("TEST.xls").Activate
    Range("L73:M76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Windows("TEST.xls").Activate
    ActiveWindow.SmallScroll Down:=-78
    Range("A1:H2").Select
 
End Sub

[Nicolas JACQUIN]

seulement copier les valeur pas de mise en forme ni formule

remplace

Code :

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

Paste:=xlPasteAllUsingSourceTheme

par

Code :

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

Paste:=xlPasteValues

comme précisé plus haut

[Gordongekko]

slt,

ce code me pose problème de débogage pas celui de haut

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Range("H" & derlign - 3 & ":I" & derlign).ClearContents
Windows("TEST.xls").Activate
    Range("D73:E76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Range("K" & derlign - 3 & ":L" & derlign).ClearContents
Windows("TEST.xls").Activate
    Range("F73:G76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Range("N" & derlign - 3 & ":O" & derlign).ClearContents
Windows("TEST.xls").Activate
    Range("H73:I76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Range("Q" & derlign - 3 & ":R" & derlign).ClearContents
Windows("TEST.xls").Activate
    Range("J73:K76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Range("T" & derlign - 3 & ":U" & derlign).ClearContents
Windows("TEST.xls").Activate
    Range("L73:M76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Windows("TEST.xls").Activate
    ActiveWindow.SmallScroll Down:=-78
    Range("A1:H2").Select

[Nicolas JACQUIN]

tu peux peut-être mettre ton code entier et dire à quel ligne ton code pose problème,
à première vu il y a déjà des lignes en trop
ou joint tes deux classeurs

[Gordongekko]

Voici le code complet cher Nicols,

Peut être que je n'ai pas réussi a vous expliquer le processus.
Bref, le code d'ajouter des lignes en-dessous de la dernière et effacé le contenu fonctionne a merveille. le problème vient après car au lieu de saisir les données manuellement d'un autre classeur je veux qu'il soit automatisé via cette macros.
j'ai deux classeur Excel : le premier TEST.xls qui calcul des données journalier chaque jours les données s’écrase pour donner de nouveau chiffre chaque jours.
le deuxième classeur "STAT BBE.xlsx" est celui un back up qui sauvegarde l'historique pour chaque jours.

mon objectif tjrs le même ajouter une dernière ligne au classeur "STAT BBE.xlsx" et saisir les données de N jours.
mon soucis que le code copier/coller des valeurs uniquement depuis "TEST.xls" vers les lignes ajouter au classeur "STAT BBE.xlsx" ne fonctionne pas.

en ce qui concerne le trop de ligne c'est obligatoire car lors du collage il y a des cellules ici "G" "K" "M" "S" et "V" qui additionne celle des cellules précédente: i.e pour "K" = sommes "E,F"

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Sub STAT()
'
' STAT Macro
'
 
'
    ChDir "C:\Users\mega-pc\Desktop\MACROS EXCEL"
    Workbooks.Open Filename:= _
        "C:\Users\mega-pc\Desktop\MACROS EXCEL\STAT BBE.xlsx"
   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("C" & derlign - 3 & ":C" & derlign).Value = Date
Range("E" & derlign - 3 & ":F" & derlign).ClearContents
Windows("TEST.xls").Activate
Range("B73:C76").Select
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Range("H" & derlign - 3 & ":I" & derlign).ClearContents
Windows("TEST.xls").Activate
    Range("D73:E76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Range("K" & derlign - 3 & ":L" & derlign).ClearContents
Windows("TEST.xls").Activate
    Range("F73:G76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Range("N" & derlign - 3 & ":O" & derlign).ClearContents
Windows("TEST.xls").Activate
    Range("H73:I76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Range("Q" & derlign - 3 & ":R" & derlign).ClearContents
Windows("TEST.xls").Activate
    Range("J73:K76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
Range("T" & derlign - 3 & ":U" & derlign).ClearContents
Windows("TEST.xls").Activate
    Range("L73:M76").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("STAT BBE.xlsx").Activate
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Windows("TEST.xls").Activate
    ActiveWindow.SmallScroll Down:=-78
    Range("A1:H2").Select
 
End Sub

[Nicolas JACQUIN]

Code :

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

derligne = Worksheets("Feuil1").Range("B65536").End(xlUp).Row

Déjà là, Excel ne sait pas que c'est la dernière ligne de ton classeur "test" puisque à ce moment là c'est ton classeur "stat bbe" qui est actif

le plus facile serai de faire une copie directement dans le classeur "stat bbe"

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
Sub STAT()
 
ChDir "C:\Users\mega-pc\Desktop\MACROS EXCEL"
    Workbooks.Open Filename:= _
        "C:\Users\mega-pc\Desktop\MACROS EXCEL\STAT BBE.xlsx"
 
Workbooks("TEST.xlsm").Sheets("Feuil1").Copy Before:=Workbooks("STAT BBE.xlsx").Sheets(1)
    Workbooks("STAT BBE.xlsx").Sheets("Feuil1").Name = Range("C3").Value
    ActiveWorkbook.Save
    ActiveWindow.Close
MsgBox "Good save"
 
Range("E" & derlign - 3 & ":F" & derlign).ClearContents
Range("H" & derlign - 3 & ":I" & derlign).ClearContents
Range("K" & derlign - 3 & ":L" & derlign).ClearContents
Range("N" & derlign - 3 & ":O" & derlign).ClearContents
Range("Q" & derlign - 3 & ":R" & derlign).ClearContents
Range("T" & derlign - 3 & ":U" & derlign).ClearContents
 
End Sub

dis ce que tu en pense

[Gordongekko]

j'ai pas bien saisie ta réponse mais l'ajout de la derniere ligne c'est bel et bien dans le classeur "stat BBE" et non pas "TEST" le reste de copiage c'est depuis ds cellules du "TEST" vers "stat BBE" puis sauvegarder le classeur "stat BBE" quitter et retourner vers "TEST".

je sais que ma requête est un peux compliquer mais elle est primordiale pour l'historique.

j'espére dear friend que vous m'avez compris.

[Nicolas JACQUIN]

En faites, non j'ai pas tout compris, mais j'ai essayé de remettre les choses en ordres par rapport à ma logique ,
à essayer.

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
Dim derligne As Integer
Dim derlign As Integer
Dim dertest As Integer
ChDir "E:\Users\Nicolas\Desktop"
    Workbooks.Open Filename:= _
        "E:\Users\Nicolas\Desktop\STAT BBE.xlsx"
derligne = Workbooks("STAT BBE.xlsx").Sheets("Feuil1").Range("B65536").End(xlUp).Row
    Workbooks("TEST.xlsm").Sheets("Feuil1").Range("B7:V10").Copy
    Workbooks("STAT BBE.xlsx").Sheets("Feuil1").Range("B" & derligne + 2).PasteSpecial
derlign = Workbooks("STAT BBE.xlsx").Worksheets("Feuil1").Range("C65536").End(xlUp).Row
Workbooks("STAT BBE.xlsx").Worksheets("Feuil1").Range("C" & derlign - 3 & ":C" & derlign).Value = Date
Workbooks("STAT BBE.xlsx").Worksheets("Feuil1").Range("E" & derlign - 3 & ":F" & derlign).ClearContents
    Workbooks("TEST.xlsm").Sheets("Feuil1").Range("B73:M76").Copy
    Workbooks("STAT BBE.xlsx").Sheets("Feuil1").PasteSpecial
ActiveWorkbook.Save
ActiveWindow.Close
dertest = Workbooks("TEST.xlsm").Sheets("Feuil1").Range("B65536").End(xlUp).Row
Range("E" & dertest - 3 & ":F" & dertest).ClearContents
Range("H" & dertest - 3 & ":I" & dertest).ClearContents
Range("K" & dertest - 3 & ":L" & dertest).ClearContents
Range("N" & dertest - 3 & ":O" & dertest).ClearContents
Range("Q" & dertest - 3 & ":R" & dertest).ClearContents
Range("T" & dertest - 3 & ":U" & dertest).ClearContents

[Gordongekko]

Bonsoir

voila les 2 classeurs pour que vous pouvez comprendre d'ou je copie et je colle

[Nicolas JACQUIN]

Dans quel sens tu veux faire tes copies ???, il n'y a rien de cohérent dans ton code et tes classeurs, c'est je mets, je retire, je remet, mais on ne sait plus dans quel sens on est.

[Gordongekko]

c'est simple copier les chiffres a partir de "test" puis coller ces chiffres dans le classeur "stat bb"
bref le classeur "stat bb" sert d'un sauvegarde quotidien c'est pour ca que j'ai demandé d'ajouter des lignes aprés la dernière et d'y mentionné la date.

j'espere que vous m'avez compris

[Nicolas JACQUIN]

essai comme ça

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
Sub backup()
ChDir "C:\Users\mega-pc\Desktop\MACROS EXCEL"
    Workbooks.Open Filename:= _
        "C:\Users\mega-pc\Desktop\MACROS EXCEL\STAT BBE.xlsx"
 Dim derligne As Integer
 Dim derlign As Integer
    derligne = Workbooks("STAT BBE").Sheets("Feuil1").Range("B65536").End(xlUp).Row
Workbooks("STAT BBE").Sheets("Feuil1").Range("B" & derligne - 3 & ":V" & derligne).Copy
Workbooks("STAT BBE").Sheets("Feuil1").Range("B" & derligne + 1).PasteSpecial
Workbooks("STAT BBE").Sheets("Feuil1").Range("B" & derligne - 3 & ":B" & derligne).Value = Date
    derlign = Workbooks("TEST").Sheets("Feuil1").Range("B65536").End(xlUp).Row
Workbooks("TEST").Sheets("Feuil1").Range("B" & derlign - 3 & ":C" & derlign).Copy
Workbooks("STAT BBE").Sheets("Feuil1").Range("E" & derligne - 3).PasteSpecial
    Workbooks("TEST").Sheets("Feuil1").Range("D" & derlign - 3 & ":E" & derlign).Copy
    Workbooks("STAT BBE").Sheets("Feuil1").Range("H" & derligne - 3).PasteSpecial
        Workbooks("TEST").Sheets("Feuil1").Range("F" & derlign - 3 & ":G" & derlign).Copy
        Workbooks("STAT BBE").Sheets("Feuil1").Range("K" & derligne - 3).PasteSpecial
        Workbooks("TEST").Sheets("Feuil1").Range("H" & derlign - 3 & ":I" & derlign).Copy
        Workbooks("STAT BBE").Sheets("Feuil1").Range("N" & derligne - 3).PasteSpecial
    Workbooks("TEST").Sheets("Feuil1").Range("J" & derlign - 3 & ":K" & derlign).Copy
    Workbooks("STAT BBE").Sheets("Feuil1").Range("Q" & derligne - 3).PasteSpecial
Workbooks("TEST").Sheets("Feuil1").Range("L" & derlign - 3 & ":M" & derlign).Copy
Workbooks("STAT BBE").Sheets("Feuil1").Range("T" & derligne - 3).PasteSpecial
End Sub

[Gordongekko]

erreur lors de l’exécution de ce code "indice n'appartient pas a la sélection"

Code :

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

derligne = Workbooks("STAT BBE").Sheets("Feuil1").Range("B65536").End(xlUp).Row