Macro ouverture Fichier puis enregistrement : Comment la simplifier ?

[mattwarend]

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) :

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 :

     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.

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

 

[jp14]

Re : Macro ouverture Fichier puis enregistrement : Comment la simplifier ?

Bonjour

Pour simplifier il serait nécessaire d'avoir un fichier avec un exemple de la feuille à obtenir.

JP