Comment simplifier ma macro

Version imprimable

Bonjour à tous,

A partir de l'enregistreur de macro, de codes à la réponse à mes post précédents (merci à Chris78, Menhir, Halaster08) et de codes trouvés sur le forum, je vous propose la macro "Génération_Ecriture". Elle fonctionne bien mais elle est vraiment le fruit d'un débutant.

Si quelqu'un pouvait y jeter un oeil et, pour que je progresse dans le VBA, m'apporte ses commentaires, corrections, simplifications, ...

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
87
88
89
90
91
92
93
94
 
 
Sub Génération_Ecriture()
'
' génére l'écriture et la colle dans le journal VT
' 19/04 Fonctionne
 
    Sheets("Matrice Facture").Select
 
    ' En X2 on a le pays de facturation
    ' Si X2 = FRANCE METROPOLITAINE alors Range("M57:S60").Copy
    ' Sinon Range("M64:S66").Copy
 
    If Range("X2") = "FRANCE METROPOLITAINE" Then
    ' Pour import journal Ventes en France
    Range("M57:S60").Copy 'copie l'écriture avec TVA
    End If
 
    If Range("X2") <> "FRANCE METROPOLITAINE" Then
    ' Pour import journal Ventes hors France sans TVA
    Range("M64:S66").Copy 'copie l'écriture sans TVA
    End If
 
    Sheets("Journal VT").Select
    Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues) 'collage spécial
 
    ' Pour mettre Bordures de l'écriture importée qui sont "perdues" pendant le copier / collage spécial
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        '.ColorIndex = 0
        '.TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        'LineStyle = xlContinuous
        '.ColorIndex = 0
        '.TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        '.ColorIndex = 0
        '.TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        '.ColorIndex = 0
        '.TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        '.ColorIndex = 0
        '.TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        '.ColorIndex = 0
        '.TintAndShade = 0
        .Weight = xlThin
    End With
 
    'trouve la dernière ligne dans G
    Cells(Rows.Count, "G").End(xlUp).Select
 
    'Supprimer la dernière ligne collée si elle contient 0 colonne G (si O = frais de port à 0 donc dernière ligne pas nécessaire
    If Cells(Rows.Count, "G").End(xlUp).Value = 0 Then
    Selection.Delete Shift:=xlUp                'supprime la valeur de la cellule sélectionnée
    Cells(Rows.Count, "F").End(xlUp).Select
    Selection.Rows.Delete Shift:=xlUp
    Cells(Rows.Count, "E").End(xlUp).Select
    Selection.Rows.Delete Shift:=xlUp
    Cells(Rows.Count, "D").End(xlUp).Select
    Selection.Rows.Delete Shift:=xlUp
    Cells(Rows.Count, "C").End(xlUp).Select
    Selection.Rows.Delete Shift:=xlUp
    Cells(Rows.Count, "B").End(xlUp).Select
    Selection.Rows.Delete Shift:=xlUp
    Cells(Rows.Count, "A").End(xlUp).Select
    Selection.Rows.Delete Shift:=xlUp
    End If
 
    ' Pour déselectionner l'écriture
    Sheets("Matrice Facture").Select
    Range("S60").Select
    Application.CutCopyMode = False
 
    Sheets("Accueil").Select ' Retour_Accueil
    Range("L11").Select
End Sub

Merci à vous

Philippe

Bonsoir, Je ne suis pas sur que ça va marcher, mais le premier Collage spécial colle la valeur et le deuxième le Format.
Si ça fonctionne, ça permettrais d'enlever tout le reste du formatage.
Code:

1 2 Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues) 'collage spécial Valeurs Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlFormats 'collage spécial Format
Cordialement 8-)

19/04/2018, 18h41
unparia

Bonjour
Pourquoi ne pas utiliser la méthode Range.copy (qui copie tout, format de cellules compris) et ne corriger au besoin que ce qui ne conviendrait pas (couleur de fond et de police) ?

Code:

1
2
3
4
5
6
7
8
9
Sub Génération_Ecriture()
    Dim sh1 As Worksheet, sh2 As Worksheet, plage As Range
    Set sh1 = Sheets("Matrice Facture")
    Set sh2 = Sheets("Journal VT")
    Set plage = IIf(Range("X2") = "FRANCE METROPOLITAINE", Range("M57:S60"), Range("M64:S66"))
    plage.Copy Destination:=sh2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'....le formatage est envoyé avec 
'....
End Sub

20/04/2018, 10h58
Menhir
Citation:
Envoyé par patricktoulon

Code:

1 2 Set plage = IIf(Range("X2") = "FRANCE METROPOLITAINE", Range("M57:S60"), Range("M64:S66")) plage.Copy Destination:=sh2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
Voir même :

Code:

IIf(Range("X2") = "FRANCE METROPOLITAINE", Range("M57:S60"), Range("M64:S66")).Copy Destination:=sh2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)

Ca évite une variable.
20/04/2018, 15h09
Phil333250

Bonjour,

Merci pour vos interventions.

Citation:

Transitoire
Bonsoir, Je ne suis pas sur que ça va marcher, mais le premier Collage spécial colle la valeur et le deuxième le Format.
Si ça fonctionne, ça permettrais d'enlever tout le reste du formatage.

1 Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues) 'collage spécial Valeurs
2 Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlFormats 'collage spécial Format

Cette solution colle le format en dessous du collage spécial valeurs.
J'ai réussi en jouant sur le Offset en mettant -3 pour faire remonter la selection, cela fonctionne pour les lgnes au dessus mais pas pour la dernière ligne qui n'a donc pas le format.

Citation:

patricktoulon
Sub Génération_Ecriture()
Dim sh1 As Worksheet, sh2 As Worksheet, plage As Range
Set sh1 = Sheets("Matrice Facture")
Set sh2 = Sheets("Journal VT")
Set plage = IIf(Range("X2") = "FRANCE METROPOLITAINE", Range("M57:S60"), Range("M64:S66"))
plage.Copy Destination:=sh2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
'....le formatage est envoyé avec
'....
End Sub

Je ne comprends pas comment on sait que Range("X2") .... se trouve dans Sheets("Matrice Facture").
Dans Set plage cela n'y fait pas référence.

La solution fonctionne mais comme un copier/coller classique donc les formules sont collées. J'ai besoin de copier les valeurs (et non les formules)

Menhir, ta solution fonctionne mais même remarques que ci dessus.

Merci encore pour votre aide

Philippe

Bonjour,
Je vois l'erreur, essayé cela

Code:

1
2
3
4
5
 Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).select
With selection
      .PasteSpecial (xlPasteValues) 'collage spécial Valeurs
      .PasteSpecial Paste:=xlFormats 'collage spécial Format 
EndWith

Cordialement 8-)

20/04/2018, 15h43
Phil333250

Re,

Merci transitoire, cela fonctionne bien (juste un espace entre End et With).

Sans abuser, aurais tu une astuce pour simplifier les lignes 71 à 85 du code de mon premier message.

Philippe

Re, exact pour l'espace, dans les modules, il se met tout seul:D
Si toute la ligne est libre J'essayerais ça. Possible d'adapter?
Code:

1 2 3 4 5 6 Cells(Rows.Count, "G").End(xlUp).Select 'Supprimer la dernière ligne collée si elle contient 0 colonne G (si O = frais de port à 0 donc dernière ligne pas nécessaire If Cells(Rows.Count, "G").End(xlUp).Value = 0 Then Cells(Rows.Count, "G").End(xlUp).EntireRow.Delete else End if
sinon si la ligne n'est pas vide après G , il faut sélectionner la zone (Ax : Gx) et Delete
Cordialement 8-)

21/04/2018, 10h12
Phil333250

Bonjour Transitoire,

Cela fonctionne très bien.

Merci beaucoup