Tri automatique a partir dun autres fichier Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
f
fleurmi
Membre habitué
Membre habitué
Messages : 52
Appréciation reçue : 1
Inscrit le : 22 avril 2018
Version d'Excel : 2016

Message par fleurmi » 15 janvier 2019, 13:48

Bonjour à tous,

Suite a mon ancien Sujet sur l'archivage de données, j'aurai souhaitée continuée dans la lancer de l'automatisation.

Ainsi serait-t-il possible a partir de mon Ficher d'Archivage de programmer un code vba me permettant de trié la colonne R de mon Fichier de Base .

Grace a l'enregistreur de macro il ma généré ce code :

code simple :
 ActiveWorkbook.Worksheets("base").AutoFilter.Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("base").AutoFilter.Sort.SortFields.Add Key:=Range( _
 "R2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 xlSortNormal
 With ActiveWorkbook.Worksheets("base").AutoFilter.Sort
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
 ActiveWorkbook.Worksheets("base").AutoFilter.Sort.SortFields.Clear
 Windows("archive.xlsm").Activate
 .Close True
 End With
 Set rng = Nothing
 Application.ScreenUpdating = True
 End sub
Le problème dans ce code est qu'il faut que mon fichier soit ouvert , deplus il me mais une erreur :/

ET voici le code mon archivage ( qui marche du tonner ) :
Option Explicit
 Sub test()
 Dim rng As Range
 Application.ScreenUpdating = False
 'ouverture du fichier source
 With Workbooks.Open(ThisWorkbook.Path & "\base.xlsx")
 With .Sheets("base")
 .AutoFilterMode = False
 With .Range("a1").CurrentRegion
 'filtre des donnees sur la 2eme colonne
 .AutoFilter 2, "terminé"
 On Error Resume Next
 'les lignes visibles sans la ligne d'en-tetes
 Set rng = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
 On Error GoTo 0
 If Not rng Is Nothing Then
'copie les lignes filtrees
 rng.Copy
 'colle les lignes filtrees dans le fichier cible
 With ThisWorkbook.Sheets("archive")
 .Range("a" & Rows.Count).End(xlUp)(2) _
 .PasteSpecial xlPasteValues
 End With
 MsgBox "Copie de " & Application.Subtotal(3, .Columns("b")) - 1 & " ligne(s)"
 'suppression des lignes filtrees du fichier source
 rng.EntireRow.Delete
 Else
 MsgBox "Aucune donnée à copier"
 End If
 .AutoFilter
 End With
 End With
End sub

J'aurai souhaitée la compilation des 2 => Celui-ci m'affiche un message d'erreur ::o

Je continue de chercher,

merci d'avance pour votre aide

Cordialement
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message