Macro vba excel

Résolu
neofithe Messages postés 26 Date d'inscription dimanche 28 mai 2017 Statut Membre Dernière intervention 8 novembre 2023 - 27 sept. 2023 à 11:11
neofithe Messages postés 26 Date d'inscription dimanche 28 mai 2017 Statut Membre Dernière intervention 8 novembre 2023 - 1 oct. 2023 à 10:35

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

Merci à vous 

A voir également:

3 réponses

neofithe Messages postés 26 Date d'inscription dimanche 28 mai 2017 Statut Membre Dernière intervention 8 novembre 2023
27 sept. 2023 à 11:17

erratum: le code en gras est uniquement destiné à mettre des slashs en colonne A

Merci

0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 702
30 sept. 2023 à 07:25

Bonjour,

Pouvez mettre un fichier exemple a dispo

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...
 

0
neofithe Messages postés 26 Date d'inscription dimanche 28 mai 2017 Statut Membre Dernière intervention 8 novembre 2023
1 oct. 2023 à 10:35

Merci pour l'info

0