re
Faites comme ceci
1. Allez dans THISWORKBOOK
2. Supprimez tout le code que vous avez et remplacez-le par celui ci-dessous
Private Sub Workbook_Open()
Call CreerSuivi
End Sub
3. Dans l'éditeur VBA, allez dans le menu Insertion et cliquez sur "Module"
4. dans la fenêtre de ce nouveau module, mettez ce code
Option Explicit
Sub CreerSuivi()
Dim Nsheet As String, fexi As String
Dim j As Integer, dligne As Integer
Dim realise As Boolean
Dim c As Range
fexi = "1"
Nsheet = "Suivi" 'Nom donné à la feuille d'export et de traitement des données
On Error Resume Next
Application.DisplayAlerts = False
Worksheets(Nsheet).Delete 'supprimer feuille suivi
Application.DisplayAlerts = True
Worksheets.Add.Name = Nsheet 'creer feuille suivi
With Worksheets(fexi)
'Copie les colonnes dans la nouvelle feuille suivi
Set c = .Rows(1).Find("Projet", LookIn:=xlValues)
.Columns(c.Column).Copy Sheets(Nsheet).Columns(1)
Set c = .Rows(1).Find("Sous-famille", LookIn:=xlValues)
.Columns(c.Column).Copy Sheets(Nsheet).Columns(2)
Set c = .Rows(1).Find("Modèle", LookIn:=xlValues)
.Columns(c.Column).Copy Sheets(Nsheet).Columns(3)
Set c = .Rows(1).Find("Quant. util.", LookIn:=xlValues)
.Columns(c.Column).Copy Sheets(Nsheet).Columns(4)
Set c = .Rows(1).Find("Jours Tot.", LookIn:=xlValues)
.Columns(c.Column).Copy Sheets(Nsheet).Columns(5)
Set c = .Rows(1).Find("Taux Princ.", LookIn:=xlValues)
.Columns(c.Column).Copy Sheets(Nsheet).Columns(6)
Set c = .Rows(1).Find("Date de début", LookIn:=xlValues)
.Columns(c.Column).Copy Sheets(Nsheet).Columns(8)
Set c = .Rows(1).Find("Date de fin", LookIn:=xlValues)
.Columns(c.Column).Copy Sheets(Nsheet).Columns(9)
End With
With Worksheets(Nsheet)
dligne = .UsedRange.Rows.Count
For j = 2 To dligne
If .Range("d" & j) = "0" Then .Range("d" & j) = 1
.Range("f" & j) = Replace(.Range("f" & j), ",", ".")
.Range("g" & j) = Replace(.Range("g" & j), ",", ".")
.Range("G" & j).FormulaLocal = "=E" & j & "*F" & j
Next j
.Range("g2:g" & dligne).Formula = "=d2*e2*f2"
'mise en forme
With .Range("A1:I1")
.Font.Bold = True
.Font.Underline = xlUnderlineStyleSingle
End With
.ListObjects.Add(xlSrcRange, Range("$A$1:$I$" & dligne), , xlYes).Name = "Tableau1"
With .ListObjects("Tableau1")
.TableStyle = "TableStyleMedium2"
.Range.EntireColumn.AutoFit
.ShowTotals = True
.HeaderRowRange(7) = "Total Mensuel"
.ListColumns(7).TotalsCalculation = xlTotalsCalculationSum
End With
End With
End Sub
Si ok, pensez à cloturer le fil
Crdlt