Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Macro ouverture Fichier puis enregistrement : Comment la simplifier ?

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
M

mattwarend

XLDnaute Junior
Bonjour à tous,

J'utilise une macro pour ouvrir un fichier .txt, faire un mise en page, et sélectionner une ligne précise (emplacement UNC) :

Code: 
Rows("3:3").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="<>\\eufrhqfs02wp\USERS\Actuaria", _

puis enregistrer mon fichier modifié dans ce même emplacement :

Code: 
     ChDir "P:\Actuaria\ZXFILES_REPORT"
    ActiveWorkbook.SaveAs Filename:="P:\Actuaria\ZXFILES_REPORT\Quota.xls" _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
    Application.DisplayAlerts = True


Je souhaiterais maintenant pouvoir rendre cette macro adaptative (sur un autre serveur, avec d'autres emplacements).
Je ne sais pas du tout par où commencer ni comment procéder.

Voici mon code complet pour info.

Code: 
Sub auto_open()

    ChDir "C:\Documents and Settings\admincot\Desktop"
    Workbooks.OpenText Filename:="\\Eufrhqfs02wp\quotalog\Usage.txt", Origin:= _
        xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True

    Rows("1:5").Select
    Range("A5").Activate
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    
        Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
        TrailingMinusNumbers:=True
   
    Range("A3:A3000").Select
    ActiveWindow.ScrollRow = 3000
    ActiveWindow.ScrollRow = 1
    
    'Selection.TextToColumns Destination:=Range("A3"), AMOType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
        TrailingMinusNumbers:=True
        
    Rows("3:3").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="<>\\eufrhqfs02wp\USERS\Actuaria", _
        Operator:=xlAnd
    Selection.ClearContents
    Range("A3:A3000").Select
    ActiveWindow.ScrollRow = 3000
    ActiveWindow.ScrollRow = 1
If WorksheetFunction.CountA(Cells) = 0 Then
MsgBox "Feuille vide !"
Exit Sub
End If
With ActiveSheet.UsedRange
LastRow = .Cells(.Cells.Count).Row
End With
For R = LastRow To 1 Step -1
If WorksheetFunction.CountA(Rows(R)) = 0 Then
Rows(R).Delete
End If
Next R
Range("A1:E2").Select
    Range("E2").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
On Error Resume Next
    Range("A1:E1").Select
    Range("E1").Activate
    Selection.Font.Bold = True
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Range("A1").Select
        Application.DisplayAlerts = False
    ChDir "P:\Actuaria\ZXFILES_REPORT"
    ActiveWorkbook.SaveAs Filename:="P:\Actuaria\ZXFILES_REPORT\Quota.xls" _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
    Application.DisplayAlerts = True
    
  
      ChDir "C:\Documents and Settings\admincot\Desktop"
    Workbooks.OpenText Filename:="\\Eufrhqfs02wp\quotalog\Usage.txt", Origin:= _
        xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), TrailingMinusNumbers:=True

    Rows("1:5").Select
    Range("A5").Activate
    Selection.Delete Shift:=xlUp
    Range("A1").Select
    
        Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
        TrailingMinusNumbers:=True
   
    Range("A3:A3000").Select
    ActiveWindow.ScrollRow = 3000
    ActiveWindow.ScrollRow = 1
    
    'Selection.TextToColumns Destination:=Range("A3"), AMOType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
        TrailingMinusNumbers:=True
        
    Rows("3:3").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="<>\\eufrhqfs02wp\USERS\ADMINIST", _
        Operator:=xlAnd
    Selection.ClearContents
    Range("A3:A3000").Select
    ActiveWindow.ScrollRow = 3000
    ActiveWindow.ScrollRow = 1
If WorksheetFunction.CountA(Cells) = 0 Then
MsgBox "Feuille vide !"
Exit Sub
End If
With ActiveSheet.UsedRange
LastRow = .Cells(.Cells.Count).Row
End With
For R = LastRow To 1 Step -1
If WorksheetFunction.CountA(Rows(R)) = 0 Then
Rows(R).Delete
End If
Next R
Range("A1:E2").Select
    Range("E2").Activate
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
    .ColorIndex = xlAutomatic
End With
On Error Resume Next
    Range("A1:E1").Select
    Range("E1").Activate
    Selection.Font.Bold = True
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Range("A1").Select
        Application.DisplayAlerts = False
    ChDir "P:\ADMINIST\ZXFILES_REPORT"
    ActiveWorkbook.SaveAs Filename:="P:\ADMINIST\ZXFILES_REPORT\Quota.xls" _
        , FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWindow.Close
    Application.DisplayAlerts = True

Excel.Application.Quit
    End Sub
 

Pièces jointes

Dernière édition:
Trier par date Trier par votes
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

L
  • Question Question
XL 2016 Actualisation d'une query via VBA
Réponses
5
Affichages
567
job75
U
  • Question Question
Autres [RÉSOLU] Compléter la macro mais comment et où?
Réponses
2
Affichages
240
un internaute
U
E
  • Résolu(e)
Microsoft 365 Convertir en -tete tableau en date
Réponses
14
Affichages
727
eric72
E
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
1 K
Nicolas JACQUIN
R
  • Question Question
XL 2016 Barre de progression
Réponses
1
Affichages
821
sylvanu
L
  • Question Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
874
fanfan38
  • Question Question
XL 2019 modifier une macro
Réponses
2
Affichages
1 K
Ferbank
  • Question Question
XL 2016 Remplacer cellules vides par zéro dans plage variable.
Réponses
2
Affichages
806
job75
J
  • Question Question
XL 2019 Borné une extraction par date
2
Réponses
22
Affichages
3 K
jui42
J
K
  • Question Question
XL 2016 Ouverture d'un fichier .txt (avec partie variable) puis enregistrement sous .csv avec nom défini
2
Réponses
15
Affichages
2 K
dysorthographie
S
  • Question Question
Aide sur La fin d'une Macro SVP
Réponses
3
Affichages
756
sylvanu
A
  • Question Question
Microsoft 365 boucle macro pour importer des données
2
Réponses
16
Affichages
2 K
Arnaud Legay
A
K
  • Question Question
XL 2019 Extraction données avec filtre d'un fichier .txt sur Excel & créer nouveau fichier .txt
Réponses
1
Affichages
3 K
Hasco
  • Question Question
Microsoft 365 Mauvais format date dans l'export de données csv avec code VBA
Réponses
5
Affichages
2 K
chris
L
  • Question Question
Microsoft 365 Problème erreur range
Réponses
11
Affichages
2 K
LaSimonerie
L
R
  • Question Question
XL 2010 VBA : consolidation
Réponses
2
Affichages
892
Rousseau Benoit
R
  • Question Question
XL 2019 "Améliorer" un code VBA
Réponses
13
Affichages
2 K
bambi
O
  • Question Question
Microsoft 365 macro pour agréger différents fichiers CSV dans un fichier XLSM
Réponses
10
Affichages
2 K
dysorthographie
  • Question Question
XL 2010 Extraction SQL et Format date
Réponses
2
Affichages
1 K
Airone784
C
  • Question Question
XL 2010 Changer la mise en page de plusieurs fichiers dans un dossier
Réponses
1
Affichages
945
Yaloo
Y
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…