Ajouter une ligne en fin de tableau excel avec une vba

Version imprimable

1 pièce(s) jointe(s)

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:
Pièce jointe 262505
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 malheureusementPièce jointe 262505
Code:

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

Bonjour et bienvenue sur le forum
A tester

Code:

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

09/04/2017, 12h12
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?
09/04/2017, 12h35
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. :weird:

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:

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

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

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:

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

19/04/2017, 01h13
Nicolas JACQUIN

Bonjour l'ami,

en reprenant le dernier code donné, remplace:

Code:

Paste:=xlPasteAllUsingSourceTheme

par

Code:

Paste:=xlPasteValues

et

Code:

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

par

Code:

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

Bonne continuation.

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) :D

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:

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

22/04/2017, 17h02
Nicolas JACQUIN

Citation:

seulement copier les valeur pas de mise en forme ni formule

remplace

Code:

Paste:=xlPasteAllUsingSourceTheme

par

Code:

Paste:=xlPasteValues

comme précisé plus haut ;)

slt,

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

Code:

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

22/04/2017, 17h57
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

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:

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

Code:

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:

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

22/04/2017, 19h49
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.

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

Code:

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

;)

23/04/2017, 00h13
Gordongekko

2 pièce(s) jointe(s)

Bonsoir

voila les 2 classeurs pour que vous pouvez comprendre d'ou je copie et je colle
23/04/2017, 01h06
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. :weird:
23/04/2017, 09h10
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 :)

essai comme ça

Code:

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

23/04/2017, 10h29
Gordongekko

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

Code:

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

Code:

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
Dim STAT As Workbook
Dim TEST As Workbook
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim derligne As Integer
Dim derlign As Integer
 
ChDir "C:\Users\mega-pc\Desktop\MACROS EXCEL"
Set STAT = Workbooks.Open(Filename:= _
"C:\Users\mega-pc\Desktop\MACROS EXCEL\STAT BBE.xlsx") 'mettre le nom correct du classeur
Set F1 = STAT.Worksheets("Feuil1")
Set TEST = ThisWorkbook
Set F2 = TEST.Worksheets("Feuil1")
 
    derligne = F1.Range("B65536").End(xlUp).Row
F1.Range("B" & derligne - 3 & ":V" & derligne).Copy
    F1.Range("B" & derligne + 1).PasteSpecial
        F1.Range("B" & derligne - 3 & ":B" & derligne).Value = Date
    derlign = F2.Range("B65536").End(xlUp).Row
F2.Range("B" & derlign - 3 & ":C" & derlign).Copy
    F1.Range("E" & derligne - 3).PasteSpecial
        F2.Range("D" & derlign - 3 & ":E" & derlign).Copy
            F1.Range("H" & derligne - 3).PasteSpecial
                F2.Range("F" & derlign - 3 & ":G" & derlign).Copy
            F1.Range("K" & derligne - 3).PasteSpecial
        F2.Range("H" & derlign - 3 & ":I" & derlign).Copy
    F1.Range("N" & derligne - 3).PasteSpecial
F2.Range("J" & derlign - 3 & ":K" & derlign).Copy
    F1.Range("Q" & derligne - 3).PasteSpecial
        F2.Range("L" & derlign - 3 & ":M" & derlign).Copy
            F1.Range("T" & derligne - 3).PasteSpecial

et à la fin du code tu rajoute

Code:

1
2
3
4
Set TEST = Nothing
Set STAT = Nothing
Set F1 = Nothing
Set F2 = Nothing

cela permet de libérer la mémoire

23/04/2017, 11h46
Gordongekko

Cher Nicolas,

Merci infiniment cela fonctionne bien sauf 2 petites choses:

1- L'ajout en bas du classeur pas au milieu pour que les date soit dans un ordre du plus ancien au nouveau.

2- la mise en forme du collage doit respecter le classeur stat bbe car je colle seulement les valeurs pas de mise en forme ni formule ( icone "123" lors de coller)

I'll be very greatful if you succeed helping me with those issues. i know that i'm asking too much but really i need it dear friend. thanks again for all your help ;)

j'ai remodifié le code, il y avait un décalage, j'avais pas vérifié

Code:

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
Dim STAT As Workbook
Dim TEST As Workbook
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim derligne As Integer
Dim derlign As Integer
ChDir "C:\Users\mega-pc\Desktop\MACROS EXCEL"
Set STAT = Workbooks.Open(Filename:= _
"C:\Users\mega-pc\Desktop\MACROS EXCEL\STAT BBE.xlsx") 'mettre le nom correct du classeur
Set F1 = STAT.Worksheets("Feuil1")
Set TEST = ThisWorkbook
Set F2 = TEST.Worksheets("Feuil1")
derligne = F1.Range("B65536").End(xlUp).Row
F1.Range("B" & derligne - 3 & ":V" & derligne).Copy
    F1.Range("B" & derligne + 1).PasteSpecial
        F1.Range("B" & derligne - 3 & ":B" & derligne).Value = Date
    derlign = F2.Range("B65536").End(xlUp).Row
F2.Range("B" & derlign - 3 & ":C" & derlign).Copy
    F1.Range("E" & derligne + 1).PasteSpecial
        F2.Range("D" & derlign - 3 & ":E" & derlign).Copy
            F1.Range("H" & derligne + 1).PasteSpecial
                F2.Range("F" & derlign - 3 & ":G" & derlign).Copy
            F1.Range("K" & derligne + 1).PasteSpecial
        F2.Range("H" & derlign - 3 & ":I" & derlign).Copy
    F1.Range("N" & derligne + 1).PasteSpecial
F2.Range("J" & derlign - 3 & ":K" & derlign).Copy
    F1.Range("Q" & derligne + 1).PasteSpecial
        F2.Range("L" & derlign - 3 & ":M" & derlign).Copy
            F1.Range("T" & derligne + 1).PasteSpecial
STAT.Save
ActiveWindow.Close
Set TEST = Nothing
Set STAT = Nothing
Set F1 = Nothing
Set F2 = Nothing

:)

Modifies avec le code ci-dessus les

Code:

.PasteSpecial

par

Code:

.PasteSpecial Paste:=xlPasteValues

et ça va le faire ;)

Citation:

Envoyé par Nicolas JACQUIN

j'ai remodifié le code, il y avait un décalage, j'avais pas vérifié

Code:

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
Dim STAT As Workbook
Dim TEST As Workbook
Dim F1 As Worksheet
Dim F2 As Worksheet
Dim derligne As Integer
Dim derlign As Integer
ChDir "C:\Users\mega-pc\Desktop\MACROS EXCEL"
Set STAT = Workbooks.Open(Filename:= _
"C:\Users\mega-pc\Desktop\MACROS EXCEL\STAT BBE.xlsx") 'mettre le nom correct du classeur
Set F1 = STAT.Worksheets("Feuil1")
Set TEST = ThisWorkbook
Set F2 = TEST.Worksheets("Feuil1")
derligne = F1.Range("B65536").End(xlUp).Row
F1.Range("B" & derligne - 3 & ":V" & derligne).Copy
    F1.Range("B" & derligne + 1).PasteSpecial
        F1.Range("B" & derligne - 3 & ":B" & derligne).Value = Date
    derlign = F2.Range("B65536").End(xlUp).Row
F2.Range("B" & derlign - 3 & ":C" & derlign).Copy
    F1.Range("E" & derligne + 1).PasteSpecial
        F2.Range("D" & derlign - 3 & ":E" & derlign).Copy
            F1.Range("H" & derligne + 1).PasteSpecial
                F2.Range("F" & derlign - 3 & ":G" & derlign).Copy
            F1.Range("K" & derligne + 1).PasteSpecial
        F2.Range("H" & derlign - 3 & ":I" & derlign).Copy
    F1.Range("N" & derligne + 1).PasteSpecial
F2.Range("J" & derlign - 3 & ":K" & derlign).Copy
    F1.Range("Q" & derligne + 1).PasteSpecial
        F2.Range("L" & derlign - 3 & ":M" & derlign).Copy
            F1.Range("T" & derligne + 1).PasteSpecial
STAT.Save
ActiveWindow.Close
Set TEST = Nothing
Set STAT = Nothing
Set F1 = Nothing
Set F2 = Nothing

Pouvez vous editez ca svp?

1- L'ajout en bas du classeur pas au milieu pour que les date soit dans un ordre du plus ancien au nouveau.

2- la mise en forme du collage doit respecter le classeur stat bbe car je colle seulement les valeurs pas de mise en forme ni formule ( icone "123" lors de coller)

23/04/2017, 12h09
Nicolas JACQUIN

Désolé, mais je ne peux rien faire de plus que le dernier code pour ma part, bon week-end et bonne continuation ;)