Bonjour j'ai une macro qui me permet de copier sur un fichier une plage de cellules en colonne A B C en ignorant la première ligne de la plage et de la coller sur un autre fichier en colonne A B C puis supprime les doublons en colonne C si le mois de la date en colonne A correspond au mois en cours . Jusque là tout va bien sans vouloir plagié le titre d'un film.
Mais là où ça ne va plus c'est sur la dernière partie du code qui est supposé mettre des bordures à toutes les cellules et des slashs aux dates en colonne A au lieu de tirets.
la totalité du code et en caractère gras ce qui pose problème::
Sub CopierCollerBorduresEtReformatDate()
Dim PlageOrigine As Range
Dim PlageCible As Range
Dim wbCible As Workbook
Dim wsCible As Worksheet
Dim DerniereLigne As Long
Dim rng As Range
Dim i As Long
Dim moisEnCours As Date, moisCellule As Date
Dim colC As Collection
' Définir la plage à copier (en excluant la première ligne)
Set PlageOrigine = ActiveCell.CurrentRegion.Offset(1, 0).Resize(ActiveCell.CurrentRegion.Rows.Count - 1)
' Copier la plage
PlageOrigine.Copy
' Définir le classeur et la feuille cibles
Set wbCible = Workbooks("SYNTHESE FINANCIERE")
Set wsCible = wbCible.Worksheets("FACTURES")
' Trouver la première cellule vide en colonne A
DerniereLigne = wsCible.Cells(wsCible.Rows.Count, 1).End(xlUp).Row + 1
Set PlageCible = wsCible.Cells(DerniereLigne, 1)
' Coller les valeurs et les formats des nombres
PlageCible.PasteSpecial xlPasteValues
PlageCible.PasteSpecial xlPasteFormats
' Désélectionner la plage copiée
Application.CutCopyMode = False
' --- Suppression des doublons pour le mois en cours ---
' Récupérer le dernier numéro de ligne de la colonne A
DerniereLigne = wsCible.Cells(wsCible.Rows.Count, 1).End(xlUp).Row
moisEnCours = DateSerial(Year(Date), Month(Date), 1) ' Premier jour du mois en cours
Set colC = New Collection
' Parcourir de haut en bas
For i = 1 To DerniereLigne
If IsDate(wsCible.Cells(i, 1).Value) Then
moisCellule = DateSerial(Year(wsCible.Cells(i, 1).Value), _
Month(wsCible.Cells(i, 1).Value), 1)
' Si le mois de la cellule correspond au mois en cours
If moisCellule = moisEnCours Then
On Error Resume Next
colC.Add wsCible.Cells(i, 3).Value, CStr(wsCible.Cells(i, 3).Value)
' Si la valeur est déjà dans la collection, supprimer la ligne
If Err.Number <> 0 Then
wsCible.Rows(i).Delete
' Ajuster l'index et la dernière ligne
i = i - 1
DerniereLigne = DerniereLigne - 1
Err.Clear
End If
On Error GoTo 0
End If
End If
Next i
' Redéfinir la première cellule vide en colonne A après la suppression des doublons
DerniereLigne = wsCible.Cells(wsCible.Rows.Count, 1).End(xlUp).Row + 1
Set PlageCible = wsCible.Cells(DerniereLigne, 1)
' --- Ajout des bordures et reformater les dates de la colonne A ---
' Définir la plage à formater
Set rng = wsCible.Range(wsCible.Cells(PlageCible.Row, 1), wsCible.Cells(DerniereLigne, 3))
' Ajouter des bordures à toutes les cellules de la plage
With rng.Borders
.LineStyle = xlContinuous
.Color = 0
.TintAndShade = 0
.Weight = xlThin
End With
' Reformater les dates de la colonne A wsCible.Range("A" & PlageCible.Row & ":A" & DerniereLigne).TextToColumns Destination:=wsCible.Range("A" & PlageCible.Row), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 4), TrailingMinusNumbers:=True
End Sub
Si une bonne âme daigne se pencher sur le problème je lui en serai reconnaissant
Pour transmettre un fichier,
Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
il faut passer par un site de pièce jointe tel que cjoint.com
Allez sur ce site : http://cjoint.com
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...