Sub Traitement()
Dim td As Worksheet
Dim myDate As Date
Dim derligne As Long
Dim x As Range 'cellule affichant le coefficient multiplicateur 100
Dim taille As Range '1ère ligne contenant le symbole % dans les en-tête
Dim colonne As Integer 'n° de la colonne à modifier
Dim lignefin As Integer 'n° de la dernière ligne
On Error Resume Next 'si la feuille n'existe pas !
Application.DisplayAlerts = False: Sheets("traitement date").Delete: Application.DisplayAlerts = True
On Error GoTo 0 'plus de gestionnaire d'erreurs
Worksheets("PO - PB").Copy After:=Worksheets("base donnee") 'création de la feuille
ActiveSheet.Name = "traitement date" 'nom de la feuille'
Sheets("base donnee").Range("A1:DX1").Copy Sheets("traitement date").Range("A1:DX1")
ActiveSheet.AutoFilterMode = False 'desactiver les filtres'
ActiveWindow.FreezePanes = False 'désactiver les volets'
ligne = Range("A" & Rows.Count).End(xlUp).Row
colomne = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
With Sheets("traitement date")
Set taille = .Range("A2:DX100")
For Each cell In taille
'detecter date et la mettre en texte + bon format
If IsDate(cell) Then
cell.EntireColumn.Rows("2:761").Select
Selection.NumberFormat = "@"
Selection.NumberFormat = "yyyy-mm-dd"
End If
If InStr(1, cell.Text, "€") > 0 Then
cell.EntireColumn.Rows("2:761").Select
Selection.NumberFormat = "0.00" 'pour 2 décimales
End If
Next
End With
Set x = Range("A" & ligne + 10)
x.Value = 100
With Sheets("traitement date")
Set taille = .Range("A2:DX100")
For Each cell In taille
If InStr(1, cell.Text, "%") > 0 Then
colonne = cell.Column
lignefin = cell.End(xlDown).Row
x.Copy
Range(Cells(1, colonne), Cells(lignefin, colonne)).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlMultiply, SkipBlanks:=True
For i = 2 To lignefin
If CStr(Cells(i, colonne)) = "Erreur 2015" Then Cells(i, colonne) = ""
Next i
Selection.NumberFormat = "0.00"
Selection.Copy
'Selection.Offset(0, 0).Select
'Selection.EntireColumn.Insert
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
'Selection.Offset(0, 0).Delete
End If
Next
End With
'on efface la valeur 100 en bas du tableau (utilisée pour le collage spécial)
Range("A" & ligne + 10).Clear
For Each cell In Range("A2:DX761")
If cell.Value = "#REF!" Then
cell.ClearContents
End If
If cell.Value = "/" Then
cell.ClearContents
End If
Next
End Sub
