Comment simplifier ma macro

**Phil333250** · 19/04/2018, 16h20

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 :

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

**Transitoire** · 19/04/2018, 18h35

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 :

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

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

**unparia** · 19/04/2018, 18h41

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

**patricktoulon** · 20/04/2018, 10h11

re

Code :

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

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

**Menhir** · 20/04/2018, 10h58

Envoyé par patricktoulon

Code :

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

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 :

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

    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.

**Phil333250** · 20/04/2018, 15h09

Bonjour,

Merci pour vos interventions.

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.

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

**Transitoire** · 20/04/2018, 15h28

Bonjour,
Je vois l'erreur, essayé cela

Code :

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

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

**Phil333250** · 20/04/2018, 15h43

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

**Transitoire** · 20/04/2018, 17h10

Re, exact pour l'espace, dans les modules, il se met tout seul

Si toute la ligne est libre J'essayerais ça. Possible d'adapter?

Code :

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

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

**Phil333250** · 21/04/2018, 10h12

Bonjour Transitoire,

Cela fonctionne très bien.

Merci beaucoup

Comment simplifier ma macro [XL-2016]

Macros et VBA Excel

Discussions similaires

Partager

Partager