Ajouter une ligne en fin de tableau excel avec une vba

Version imprimable

Voir 40 message(s) de cette discussion en une page

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 ;)

Voir 40 message(s) de cette discussion en une page