Macro enregistrement excel 2010

Version imprimable

23/08/2017, 09h14
cybercats74

Macro enregistrement excel 2010

Bonjour.

Voila je suis tout nouveau sur voter site et j'aurais besoin de vous .

Je ne sais pas si ce site et la pour ça mais bon aller hop je me lance.

J'ai un tableau Excel sur le feuille n° 1, une fois rempli je voudrais l'enregistrer sur la feuille n° 2 la pas de problème.

Mon tableau une fois enregistrer je l'efface et je remplie une autre fois le même tableau et je voudrais aussi l'enregistrer sur ma feuille n° 2.

C'est la que le que je butte car il m'efface mon premier enregistrement.

Avec ma macro il me demande bien si je veux effacer mon premier enregistrement et quand je dit non il y a une erreur sur ma macro car il ne comprend pas et ne sais pas ou enregistrer mon tableau.

Merci pour votre aide .
23/08/2017, 09h31
riaolle
Bonjour et bienvenue au forum !
Attention, ici c'est le forum Excel, il y a un sous-forum VBA. Ce sera pour la prochaine fois ;)
QUel est ton code pour l'instant ? Nous pouvons mieux t'aider si tu nous montres ce que tu as fait jusqu'à présent. Ecris-nous le code entre balises code (bouton #) et indique nous les éventuels messages d'erreur.
Pour trouver la dernière ligne non vide de la feuille maFeuille, on utilise :
Code:

1 2 Dim derLig As Long derLig = Sheets("maFeuille").Range("A" & Rows.Count).End(xlUp).Row
Donc la ligne à partir de laquelle il faut coller, c'est derLig + 1.

Merci pour votre réponse.

Alors mon message d'erreur et 1004 la méthode pasteSpeciall de la classe Range a échoué

Et voici mon code, alors c'est un code que j'ai fait avec l'enregistrement de macro.

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
76
77
78
79
80
81
82
83
84
85
86
  Sheets("Tabelle2").Select
    Range("G1:O2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.FormulaR1C1 = "=TODAY()"
    With Selection.Font
        .Name = "Comic Sans MS"
        .Size = 11
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Selection.Font.Size = 12
    Selection.Font.Size = 14
    Selection.Font.Size = 16
    Selection.Font.Size = 18
    Selection.Font.Bold = True
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("D12").Select
    Sheets("Tabelle1").Select
    Range("A3:J16").Select
    Selection.Copy
    Sheets("Tabelle2").Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    Sheets("Tabelle1").Select
    Range("K3:U22").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Tabelle2").Select
    Range("K3").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    Range("E21").Select
    Sheets("Tabelle1").Select
    Range("F22").Select
    Application.CutCopyMode = False

Merci

un conseil : l'enregistreur de macro donne un code avec Activate/Select/Selection ... Il faut enelever tout cela, car cela entraîne souvent des prblèmes.
Ensuite, au lieu d'utiliser la méthode PasteSpecial, on peut utiliser la méthode Copy tout simplement :

Code:

Sheets("feuille source").Range("A1:D10").Copy destination:=Sheets("nvl feuille").Range("A1")

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
With Sheets("Tabelle2").Range("G1:O2")
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .Merge
        ActiveCell.FormulaR1C1 = "=TODAY()"                     '=====> Quelle est la cellule active ??? à remplacer avec qqc du type Range(...)
        With .Font
            .Name = "Comic Sans MS"
            .Strikethrough = False
            .Superscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ThemeColor = xlThemeColorLight1
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
            .Color = -16776961
            .Size = 18
            .Bold = True
       End With
       .Borders(xlDiagonalDown).LineStyle = xlNone
       .Borders(xlDiagonalUp).LineStyle = xlNone
       With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlMedium
       End With
       With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlMedium
       End With
       With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlMedium
       End With
       With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
            .Weight = xlMedium
       End With
       .Borders(xlInsideVertical).LineStyle = xlNone
       .Borders(xlInsideHorizontal).LineStyle = xlNone
 
   With Sheets("Tabelle1")
        .Range("A3:J16").Copy destination:=Sheets("Tabelle2").Range("A3")
        .Range("K3:U22").Copy destination:=Sheets("Tabelle2").Range("K3")
    End With
End With

Une grosse partie de ton code consiste à faire de la mise en forme. Il faudrait que tu essaie d'épurer cette partie là, car j'ai l'impression qu'il y a des commandes en trop.
Ici tu copies tout à partir de la ligne 3 dans la feuille "Tabelle2". Si tu veux copier à la suite, il faut utiliser derLig comme je te l'ai expliqué dans le message precedent. Tu vois comment adapter ?

23/08/2017, 10h49
cybercats74
Super je te remercie pour tes réponses.

Voila je te donne mon codes avec le moment ou il y a une erreur.

En faite je voudrais qu'a ce moment la il me demande ou l'enregistrer.
Code:

1 2 Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False
encore merci
23/08/2017, 14h19
riaolle

Citation:

En faite je voudrais qu'a ce moment la il me demande ou l'enregistrer.

Euh, je suis un peu perdue là ... Enregistrer ? Tu ne veux pas juste copier-coller à la suite de ce que tu as collé auparavant ?

Comprends-tu ce que je t'ai fourni avant ? Est-ce que tu vois comment adapter le code pour coller sur la première ligne vide ?
Plutôt que de passer par PasteSPecial, je te propose de passer seulement par Copy (cf. mon message precedent).
24/08/2017, 05h09
cybercats74

OUps.

Oui désoler je veux copier coller et non enregistrer, je suis désoler mais je ne suis pas très très bon en VBA donc je ne comprend pas tout.

merci

1 pièce(s) jointe(s)

As-tu essayé le code que je t'ai fourni ?
Quelles sont les mises en forme que tu veux appliquer ?
Si on regarde juste la partie copier-coller :
Code:

1 2 3 4 With Sheets("Tabelle1") .Range("A3:J16").Copy destination:=Sheets("Tabelle2").Range("A3") .Range("K3:U22").Copy destination:=Sheets("Tabelle2").Range("K3") End With
Ceci va copier les plages A3:J16 et K3:U22 de la feuille "Tabelle1" et les coller resp. à partir des cellules A3 et K3 dans la feuille "Tabelle2". Est-ce que tu comprends ceci ?

Ton problème, c'est que tu veux coller à la suite de ce qui a déjà été collé. Pour cela, il ne faut pas coller à partir des cellules A3 et K3 (car sinon, tu colles au même endroit, donc tu réécris par dessus), mais il faut coller à partir de la première cellule vide.
Tout d'abord, est-ce normal que les 2 plages n'ont pas le même nombre de lignes ? cf. A3:J16 vs K3:U22.
Si c'est normal, 2 façons de voir, de quelle façon veux-tu coller ?
Pièce jointe 305962
Dans tous les cas, pour trouver la dernière ligne non vide de la colonne A, par exemple, on utilise :
Code:

1 2 Dim derLigA As Long derligA = Sheets("ma feuille").Range("A" & Rows.Count).End(xlUp).Row
La première ligne vide de la colonne A est donc derLigA + 1.
Il te suffit donc de chercher cette ligne sur laquelle tu veux coller. Par ex., dans le cas de la méthode 2, on cherche la dernière ligne de la colonne K :
Code:

1 2 3 4 5 6 7 Dim derLigK As Long derLigK = Sheets("Tabelle2").Range("K" & Rows.Count).End(xlUp).Row 'puis on colle : With Sheets("Tabelle1") .Range("A3:J16").Copy destination:=Sheets("Tabelle2").Range("A" & derLigK + 1) 'on colle à partir de la ligne derLigK + 1 .Range("K3:U22").Copy destination:=Sheets("Tabelle2").Range("K" & derLigK + 1) End With
Est-ce que tu saisis l'idée ?

Merci a vous

alors voici mon code

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
Sub Test()
 
    With Sheets("Tabelle2").Range("G1:O2")
 
        .HorizontalAlignment = xlCenter
        .Merge
        .FormulaR1C1 = "=TODAY()"
 
        With .Font
 
            .Name = "Comic Sans MS"
            .Size = 18
            .Bold = True
            .Color = -16776961
 
        End With
 
        With .Borders
 
            .LineStyle = xlContinuous
            .Weight = xlMedium
 
        End With
 
    End With
 
    With Sheets("Tabelle1")
 
        .Range("A3:J16").Copy Sheets("Tabelle2").Range("A3")
        .Range("K3:U22").Copy Sheets("Tabelle2").Range("K3")
        .Range("E21").Select
 
    End With
 
End Sub

Il marche très bien, pour la mise en forme c'est la méthode 2

et je doit être très bête car je n'arrive pas a changer le code pour qu'il ne m'écrase pas mon dernier collage

Au risque de me répéter :
Citation:
Envoyé par riaolle
Code:

1 2 3 4 With Sheets("Tabelle1") .Range("A3:J16").Copy destination:=Sheets("Tabelle2").Range("A3") .Range("K3:U22").Copy destination:=Sheets("Tabelle2").Range("K3") End With
Ceci va copier les plages A3:J16 et K3:U22 de la feuille "Tabelle1" et les coller resp. à partir des cellules A3 et K3 dans la feuille "Tabelle2". Or tu veux coller à la suite de ce qui a déjà été collé. Pour cela, il ne faut pas coller à partir des cellules A3 et K3 (car sinon, tu colles au même endroit, donc tu réécris par dessus), mais il faut coller à partir de la première cellule vide.

Pour trouver la dernière ligne non vide de la colonne K, par exemple, on utilise :
Code:

1 2 Dim derLigK As Long derLigK = Sheets("ma feuille").Range("K" & Rows.Count).End(xlUp).Row
La première ligne vide de la colonne K est donc derLigK + 1. C'est la ligne sur laquelle on colle :
Code:

1 2 3 4 5 6 7 Dim derLigK As Long derLigK = Sheets("Tabelle2").Range("K" & Rows.Count).End(xlUp).Row 'puis on colle : With Sheets("Tabelle1") .Range("A3:J16").Copy destination:=Sheets("Tabelle2").Range("A" & derLigK + 1) 'on colle à partir de la ligne derLigK + 1 .Range("K3:U22").Copy destination:=Sheets("Tabelle2").Range("K" & derLigK + 1) End With