VBA - Si données dans celulle alors bordures + classement

Bonjour à tous,

La macro ci-dessous exporte des résultats dans un fichier.

Lorsqu'elle est solicitée la première fois elle créer le fichier d'export et colle les données à l'intérieur.

Lorsqu'elle est sollicitée par la suite (une quarantaine de fois) elle rajoute les résultats les uns en dessous des autres.

Jusque la aucun problème.

Je souhaiterai dans ce fichier d'export qu'il mette des bordures s'il y a une donnée dans la celulle d'une part et que d'autre part il fasse un tri chronologique de toute la colonne A avant l’enregistrement du fichier.

Merci par avance pour vos contributions.

Christophe.

Sub InjectionGlobal_1453()
Dim Chemin As String, Fichier As String
Dim Ws As Worksheet
Dim NbLg As Long

ActiveWorkbook.Unprotect Password:="200997"

  Application.ScreenUpdating = False
  Set Ws = Sheets("Saisie_masse_1453_SIRH")
  If Ws.Range("A2") = "" Then Exit Sub
  Chemin = ThisWorkbook.Path & Application.PathSeparator
  Fichier = "Saisie_masse_1453_SIRH.xlsx"
  If Dir(Chemin & Fichier) = "" Then
    Ws.Visible = xlSheetVisible
    Ws.Copy
    Ws.Visible = xlSheetHidden
    ActiveSheet.DrawingObjects.Delete
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Chemin & Fichier, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    ActiveWorkbook.Close
  Else
    NbLg = Ws.Range("A" & Rows.Count).End(xlUp).Row
    If NbLg > 1 Then
      With Workbooks.Open(Chemin & Fichier)
        Ws.Range("A2:D" & NbLg).Copy .Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        .Close savechanges:=True
      End With
    End If
  End If
  ActiveWorkbook.Protect Password:="200997"
End Sub

Concernant les bordures j'ai utilisé une MFC.

=$A2<>""
=$A$2:$D$295

Cela fonctionne, par contre je ne parviens toujours pas à classer la colonne A avant enregistrement du fichier d'export par la macro.

Bon jene sais pas si cela peut-être optimisé mais cela fonctionne :

  Range("A2:E1000").Select 
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom 
    Range("A2").Select
Rechercher des sujets similaires à "vba donnees celulle bordures classement"