XL 2016 Conserver Mise en forme lors d'une recopie sous une autre feuille

Marjo2

XLDnaute Occasionnel
Bonjour,
J'ai une macro qui va me récupérer les informations pour les mettre sous forme tableau et ainsi me permettre de faire un tri.
Seulement quand il me renvoie les valeurs du résultat sur un autre onglet, la mise en forme à bougé.
Par exemple dans l'onglet ACHAT sera écrit 2.00 et dans l'onglet Result1 sera juste écrit 2 (or le .00 est important)

Sub Recep()
'a partir de la feuille ACHAT: pour chaque code Article on ne garde que le mvt le plus r?cent
Application.ScreenUpdating = False
Dim tablo() As Variant 'd?clare un tablo VBA
With Sheets("ACHAT") 'Dans la feuille Achat
fin = .UsedRange.Rows.Count 'r?cup?re le num?ro de la derni?re ligne utilis?e
.Sort.SortFields.Clear 'on supprime les tri en cours
'on tri selon les colonnes H(CodeCC) - et I (Jour Mvt)
.Sort.SortFields.Add Key:=Range("H2:H" & fin), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
.Sort.SortFields.Add Key:=Range("I2:I" & fin), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With .Sort 'on applique les tri sur tout le tableau
.SetRange Range("A1:S" & fin)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
tablo = .Range("A2:S" & fin).Value 'on r?cup?re toute la feuille dans le tablo
End With
For i = LBound(tablo, 1) To UBound(tablo, 1) - 1
If tablo(i, 8) = tablo(i + 1, 8) Then 'si la ligne en cours et la suivante ont le meme contenu en Colonne H (8)
For j = LBound(tablo, 2) To UBound(tablo, 2) 'pour toutes les colonnes de la ligne
tablo(i, j) = "" 'on vide==> grace au tri, la ligne suivante est la plus r?cente
Next j
End If
Next i
With Sheets("Result1") 'Dans la feuille Result1
.UsedRange.Offset(1, 0).Delete 'on efface toute la feuille sauf la ligne d'entete
.Range("A2").Resize(UBound(tablo, 1), UBound(tablo, 2)) = tablo 'on colle le tableau (qui contient des lignes vides)
fin = .UsedRange.Rows.Count 'on recup?re la derni?re ligne utilis?e
.Range("H2:H" & fin).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'on supprime toutes les lignes dont la colonne H est vide
.Activate
End With
'Res1ToRes2
Application.ScreenUpdating = True
End Sub
 

Discussions similaires

Haut Bas