Ma macro ne se lance pas

**jadko212** · 16/06/2023, 09h22

Bonjour, je suis assez novice sur VBA, et je dois faire une macro qui a pour but de rajouter une nouvelle section a la fin de plusieurs feuilles (Variant de 200 à 400 par classeur) l'idée est donc de rajouter une section a la fin de chaque feuille (cette section reprends des données de la feuille existante (lié à la ligne debourses) et en rajoute de nouvelles). Par la suite je souhaiterai grouper la partie que la section vient remplacer. J'ai écris ce code mais quand je le lance rien ne fonctionne... Pouvez vous m'aider ? Je reste disponible pour tout éclaircissement ! Bonne journée à vous :

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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
Option Explicit
Sub AjouterNouvelleSection()
    Dim ws          As Worksheet
    Dim coef        As Worksheet
    Dim total1      As Double
    Dim total1bis   As Double
    Dim total4      As Double
    Dim K1          As Double
    Dim K2          As Double
    Dim K3          As Double
    Dim K4          As Double
    Dim PU          As Double
    Dim QMO         As Double
    Dim SST         As Double
    Dim SearchRange As Range
    Dim deboursesRow As Range
    Dim lastRow     As Long
    Dim rng, rng2, rng3, rng4 As Range
    'RecupŽrer les coef de la feuille coef
    Set coef = ThisWorkbook.Worksheets("Coefficients")
    With K1 = coef.Range("G4").Value
        K2 = coef.Range("G6").Value
        K3 = coef.Range("G8").Value
        K4 = coef.Range("G10").Value
    End With
    'Parcourir toutes les feuilles du classeur
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Coefficients" And ws.Name <> "BPDE" Then
            Set SearchRange = ws.Range("A1:C200")
            Set deboursesRow = ws.Range("A1:C200").Find("DEBOURSES", LookIn:=xlValues, SearchOrder:=xlRows)
            If Not deboursesRow Is Nothing Then
                lastRow = SearchRange.End(xlDown).Row
                total1bis = ws.Cells(deboursesRow.Row, 12).Value
                total1 = ws.Cells(deboursesRow.Row, 14).Value - total1bis
                total4 = ws.Cells(deboursesRow.Row, 16).Value
                PU = ws.Range("C9").Value
                QMO = ws.Cells(deboursesRow.Row, 10).Value / (total1 + total1bis + total4)
                'Remplir les valeurs dans la nouvelle section
 
                ws.Cells(lastRow + 3, 2).Value = "(1) Tous les prix sont hors TVA."
                ws.Cells(lastRow + 5, 2).Value = "(2) A complŽter pour les prix de bordereau uniquement."
                ws.Cells(lastRow + 7, 2).Value = "(3) Si les taux appliquŽs aux fournitures, aux travaux sous-traitŽs ou aux travaux exŽcutŽs"
                ws.Cells(lastRow + 8, 2).Value = "par        'entrepreneur sont diffŽrents, les faire appara”tre distinctement."
                ws.Cells(lastRow + 10, 2).Value = "(4) Si les frais gŽnŽraux de chantier comprennent une part importante de matŽriel ou de frais"
                ws.Cells(lastRow + 11, 2).Value =        'installation de chantier, faire appara”tre cette part distinctement et en donner la"
                ws.Cells(lastRow + 12, 2).Value = "dŽcomposition par nature de dŽpenses."
                ws.Cells(lastRow + 14, 2).Value = "(5)        'entrepreneur fournit le sous-dŽtail de prix du sous-traitant."
                ws.Cells(lastRow + 3, 9).Value = "TOTAL 1 (T1)"
                ws.Cells(lastRow + 3, 10).Value = "(T1) hors fournitures"
                ws.Cells(lastRow + 3, 13).Value = total1
                ws.Cells(lastRow + 4, 10).Value = "(T1 bis) part fournitures"
                ws.Cells(lastRow + 4, 13).Value = total1bis
                ws.Cells(lastRow + 6, 11).Value = "T1"
                ws.Cells(lastRow + 6, 12).Value = "T1bis"
                ws.Cells(lastRow + 7, 10).Value = "K1 frais gŽnŽraux de sige (3)"
                ws.Cells(lastRow + 7, 11).Value = K1
                ws.Cells(lastRow + 7, 12).Value = K1
                ws.Cells(lastRow + 9, 10).Value = "K2 frais gŽnŽraus de chantier (4)"
                ws.Cells(lastRow + 9, 11).Value = K2
                ws.Cells(lastRow + 9, 12).Value = K2
                ws.Cells(lastRow + 11, 10).Value = "K3 alŽas et bŽnefices"
                ws.Cells(lastRow + 10, 11).Value = K3 * (1 + K1 + K2)
                ws.Cells(lastRow + 11, 11).Value = K3 * (1 + K1 + K2)
                ws.Cells(lastRow + 13, 10).Value = "TOTAL 2 (T2) = T1 (1 + K1/100 + K2/100 + K3/100) + T1bis (1 + K1/100 + K2/100 + K3/100) =   "
                ws.Cells(lastRow + 13, 12).Value = (total1 + total1bis) * (1 + K1 + K2 + K3)
                ws.Cells(lastRow + 3, 15).Value = "K4 : frais de sous-traitance"
                ws.Cells(lastRow + 4, 15).Value = K4
                ws.Cells(lastRow + 4, 16).Value = "de T4"
                ws.Cells(lastRow + 6, 15).Value = "TOTAL 4 (T4) = T3(1 + K4/100) : "
                ws.Cells(lastRow + 7, 16).Value = total4 * (1 + K4)
                ws.Cells(lastRow + 10, 15).Value = "TOTAL GENERAL : "
                ws.Cells(lastRow + 11, 15).Value = "T2 + T4 ="
                ws.Cells(lastRow + 11, 16).Value = (total1 + total1bis) * (1 + K1 + K2 + K3) + total4 * (1 + K4)
                ws.Cells(lastRow + 13, 15).Value = "PU"
                ws.Cells(lastRow + 13, 16).Value = Round((total1 + total1bis) * (1 + K1 + K2 + K3) + total4 * (1 + K4) / PU, 2)
                ws.Cells(lastRow + 15, 15).Value = "QMO"
                ws.Cells(lastRow + 15, 16).Value = FormatPercent(QMO / (total1 + total1bis + SST))
                'Mettre une bordure autour du nouveau format
                Set rng = ws.Range("A" & (lastRow + 2) & ":G" & (lastRow + 16))        ' Added worksheet reference for rng
                With rng.Borders
                    .LineStyle = xlContinuous        'Border line style
                    .Weight = xlThin
                    .Color = RGB(0, 0, 0)
                End With
                Set rng2 = ws.Range("I" & (lastRow + 2) & ":M" & (lastRow + 16))        ' Added worksheet reference for rng2
                With rng2.Borders
                    .LineStyle = xlContinuous        'Border line style
                    .Weight = xlThin
                    .Color = RGB(0, 0, 0)
                End With
                Set rng3 = ws.Range("O" & (lastRow + 2) & ":P" & (lastRow + 8))        ' Added worksheet reference for rng3
                With rng3.Borders
                    .LineStyle = xlContinuous        'Border line style
                    .Weight = xlThin
                    .Color = RGB(0, 0, 0)
                End With
                Set rng4 = ws.Range("O" & (lastRow + 9) & ":P" & (lastRow + 16))        ' Added worksheet reference for rng4
                With rng4.Borders
                    .LineStyle = xlContinuous        'Border line style
                    .Weight = xlThin
                    .Color = RGB(0, 0, 0)
                End With
                ws.Rows((lastRow - 14) & ":" & (lastRow - 1)).OutlineLevel = 1        'Grouper les lignes de l'ancien format
                ws.Rows((lastRow - 14) & ":" & (lastRow - 1)).ShowDetail = FALSE
            End If
        End If
    Next ws
End Sub

**Franc** · 16/06/2023, 11h26

Bonjour, à priori il n'y a pas d'erreur dans le code, tu as tenté une exécution pas à pas pour vérifier le contenu des variables ?

**jadko212** · 16/06/2023, 11h39

Merci pour ta réponse, moi aussi je n'ai pas trouvé d'erreur ! Oui, le problème c'est que même lorsque je lance le pas à pas détaillé rien ne s'affiche, la première ligne du code "Sub AjouterNouvelleSection()" se surligne en jaune ... et rien d'autre

**Franc** · 16/06/2023, 13h29

Sans le fichier pour tester, perso j'ai pas d'idée.

**Philippe Tulliez** · 16/06/2023, 14h13

Bonjour?
Ne pas oublier que dans la déclaration de vos variables en ligne 18 Dim rng, rng2, rng3, rng4 As Range toutes ces variables à l'exception de rng4 sont des Variants
Ce n'est pas la cause de votre problème mais il est bon que vous le sachiez

**Philippe Tulliez** · 16/06/2023, 14h17

Bonjour,
Je vois une belle erreur de syntaxe en ligne 45

Code :

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

ws.Cells(lastRow + 11, 2).Value =        'installation de chantier, faire appara”tre cette part distinctement et en donner la"

Vous avez sans doute mis l'apostrophe au lieur d'un guillemet

Il y en a peut-être d'autres.

Utilisez la commande Compiler Vba Project avant de lancer votre programme

Ma macro ne se lance pas

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager