choisir un fichier dans une macro qui change de nom et d'emplacement à chaque fois

P

pouloucarine

XLDnaute Nouveau
Bonjour,

j'ai un traitement à faire toutes les semaines sur un fichier qui est toujours constitué pareillement.
Cependant, ce fichier est mis à dispo toutes les semaines dans un répertoire différent du type année/mois/jour du traitement, le nom du fichier étant par principe intitulé "analyse du JJ MM AA sur permanents CN CR.xlsx" (mais pourrait avoir un autre nom, le principe étant surtour qu'il ne change pas de structure.

J'ai enregistré une macro qui semble fonctionner, mais du coup, elle a écris en dur le nom du fichier (en l'état "analyse du 10 08 15 sur permanents CN CR.xlsx" puisque c'est la dernière faite.

J'aimerai que la macro fonctionne quelquesoit le nom du fichier que j'ai sélectionné (en rouge dans le code) et à la fin pouvoir éventuellement "enregistrer sous" mon fichier de sortie (qui ici s'appelle liste des produits publiés sans visuels.xlsx" sans perdre le fichier modèle.

En pj les fichiers qui servent et ci dessous la macro :)

Sub courses_u_etape9()
'
' courses_u_etape9 Macro
'

Etape 1 : depuis la macro, ouvrir fichier de compilation et le mettre à blanc sans changer les noms des onglets
ChDir _
"G:\Dir_Commerciale\Admin-Co\PartageAdminCo\COURSES U\Analyses détaillées"
Workbooks.Open Filename:= _
"G:\Dir_Commerciale\Admin-Co\PartageAdminCo\COURSES U\Analyses détaillées\Liste des produits publiés sans visuels.xlsx"
Sheets(Array("TEXTILE", "ELDPH", "FRAIS", "BAZAR")).Select
Sheets("TEXTILE").Activate
Cells.Select
Selection.ClearContents
'Etape 2 : ouvrir un fichier qui change de nom et d'emplacement toutes les semaines, y faire des manipulations de type filtre et copier le résultat dans le fichier et l'onglet approprié du fichier de compilation Liste des produits publiés sans visuels.xlsx

ChDir _ (ici je souhaite pouvoir sélectionner via fenetre exploration windows le fichier à ouvrir)
"G:\Dir_Commerciale\Admin-Co\PartageAdminCo\COURSES U\Analyses détaillées\Aout 2015\10 08 15"
Workbooks.Open Filename:= _
"G:\Dir_Commerciale\Admin-Co\PartageAdminCo\COURSES U\Analyses détaillées\Aout 2015\10 08 15\Analyse du 100815 sur permanents CN CR.xlsx" (le nom du fichier doit être celui sélectionnée au dessus)
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=10, Criteria1:=Array( _
"1", "2", "3", "4", "5", "8"), Operator:=xlFilterValues
ActiveWindow.LargeScroll ToRight:=1
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=29, Operator:= _
xlFilterNoFill
ActiveWindow.LargeScroll ToRight:=-1
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=6, Criteria1:="1"
Range("H1").Select
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=7, Criteria1:="0"
Range("A1:AD71162").Select
Range("H1").Activate
Selection.Copy
Windows("Liste des produits publiés sans visuels.xlsx").Activate
Sheets("FRAIS").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C12").Select
Windows("Analyse du 100815 sur permanents CN CR.xlsx").Activate
ActiveWindow.ScrollRow = 68232
ActiveWindow.ScrollRow = 64646
ActiveWindow.ScrollRow = 52183
ActiveWindow.ScrollRow = 28692
ActiveWindow.ScrollRow = 13809
ActiveWindow.ScrollRow = 9146
ActiveWindow.ScrollRow = 7443
ActiveWindow.ScrollRow = 6726
ActiveWindow.ScrollRow = 6098
ActiveWindow.ScrollRow = 5381
ActiveWindow.ScrollRow = 4932
ActiveWindow.ScrollRow = 4663
ActiveWindow.ScrollRow = 4394
ActiveWindow.ScrollRow = 3856
ActiveWindow.ScrollRow = 3139
ActiveWindow.ScrollRow = 2063
ActiveWindow.ScrollRow = 1525
ActiveWindow.ScrollRow = 1167
ActiveWindow.ScrollRow = 808
ActiveWindow.ScrollRow = 629
ActiveWindow.ScrollRow = 270
ActiveWindow.ScrollRow = 1
Rows("1:1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=10, Criteria1:=Array( _
"12", "13", "14"), Operator:=xlFilterValues
ActiveWindow.LargeScroll ToRight:=1
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=29, Operator:= _
xlFilterNoFill
ActiveWindow.LargeScroll ToRight:=-1
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=6, Criteria1:="1"
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=7, Criteria1:="0"
Cells.Select
Selection.Copy
Windows("Liste des produits publiés sans visuels.xlsx").Activate
Sheets("ELDPH").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C11").Select
Windows("Analyse du 100815 sur permanents CN CR.xlsx").Activate
Rows("1:1").Select
Application.CutCopyMode = False
ActiveSheet.ShowAllData
Selection.AutoFilter
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=10, Criteria1:="6"
ActiveWindow.LargeScroll ToRight:=1
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=29, Criteria1:=RGB( _
146, 208, 80), Operator:=xlFilterCellColor
ActiveWindow.LargeScroll ToRight:=-1
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=6, Criteria1:="1"
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=7, Criteria1:="0"
Cells.Select
Selection.Copy
Windows("Liste des produits publiés sans visuels.xlsx").Activate
Sheets("TEXTILE").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Windows("Analyse du 100815 sur permanents CN CR.xlsx").Activate
Rows("1:1").Select
Application.CutCopyMode = False
Selection.AutoFilter
Selection.AutoFilter
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=10, Criteria1:="=7", _
Operator:=xlOr, Criteria2:="=10"
ActiveWindow.LargeScroll ToRight:=1
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=29, Criteria1:=RGB( _
146, 208, 80), Operator:=xlFilterCellColor
ActiveWindow.LargeScroll ToRight:=-1
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=6, Criteria1:="1"
ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=7, Criteria1:="0"
Cells.Select
Selection.Copy
Windows("Liste des produits publiés sans visuels.xlsx").Activate
Sheets("BAZAR").Select
Cells.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("C11").Select
Application.CutCopyMode = False
ActiveWorkbook.Save (ici, je voudrais pouvoir choisir l'endroit et le nom où je l'enregistre)
ActiveWorkbook.Close
ActiveWindow.Close
End Sub


Si quelqu'un pouvais m'actualiser ce serait sympa

Cordialement

Jean-Sébastien Devanlay
 

Pièces jointes

  • Analyses détaillées.zip
    214.8 KB · Affichages: 21
Trier par date Trier par votes
P

PMO2

XLDnaute Accro
Re : choisir un fichier dans une macro qui change de nom et d'emplacement à chaque fo

Bonjour,

Essayez avec le code modifié (voir le passage cerné par des /////)
Code: 
Sub courses_u_etape9()
'
' courses_u_etape9 Macro
'

    ChDir _
        "G:\Dir_Commerciale\Admin-Co\PartageAdminCo\COURSES U\Analyses détaillées"
    Workbooks.Open Filename:= _
        "G:\Dir_Commerciale\Admin-Co\PartageAdminCo\COURSES U\Analyses détaillées\Liste des produits publiés sans visuels.xlsx"
    Sheets(Array("TEXTILE", "ELDPH", "FRAIS", "BAZAR")).Select
    Sheets("TEXTILE").Activate
    Cells.Select
    Selection.ClearContents
    Range("B39").Select
    Sheets("BAZAR").Select
    ChDir _
        "G:\Dir_Commerciale\Admin-Co\PartageAdminCo\COURSES U\Analyses détaillées\Aout 2015\10 08 15"
    Workbooks.Open Filename:= _
        "G:\Dir_Commerciale\Admin-Co\PartageAdminCo\COURSES U\Analyses détaillées\Aout 2015\10 08 15\Analyse du 100815 sur permanents CN CR.xlsx"
    Rows("1:1").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=10, Criteria1:=Array( _
        "1", "2", "3", "4", "5", "8"), Operator:=xlFilterValues
    ActiveWindow.LargeScroll ToRight:=1
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=29, Operator:= _
        xlFilterNoFill
    ActiveWindow.LargeScroll ToRight:=-1
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=6, Criteria1:="1"
    Range("H1").Select
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=7, Criteria1:="0"
    Range("A1:AD71162").Select
    Range("H1").Activate
    Selection.Copy
    Windows("Liste des produits publiés sans visuels.xlsx").Activate
    Sheets("FRAIS").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C12").Select
    Windows("Analyse du 100815 sur permanents CN CR.xlsx").Activate
    ActiveWindow.ScrollRow = 68232
    ActiveWindow.ScrollRow = 64646
    ActiveWindow.ScrollRow = 52183
    ActiveWindow.ScrollRow = 28692
    ActiveWindow.ScrollRow = 13809
    ActiveWindow.ScrollRow = 9146
    ActiveWindow.ScrollRow = 7443
    ActiveWindow.ScrollRow = 6726
    ActiveWindow.ScrollRow = 6098
    ActiveWindow.ScrollRow = 5381
    ActiveWindow.ScrollRow = 4932
    ActiveWindow.ScrollRow = 4663
    ActiveWindow.ScrollRow = 4394
    ActiveWindow.ScrollRow = 3856
    ActiveWindow.ScrollRow = 3139
    ActiveWindow.ScrollRow = 2063
    ActiveWindow.ScrollRow = 1525
    ActiveWindow.ScrollRow = 1167
    ActiveWindow.ScrollRow = 808
    ActiveWindow.ScrollRow = 629
    ActiveWindow.ScrollRow = 270
    ActiveWindow.ScrollRow = 1
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=10, Criteria1:=Array( _
        "12", "13", "14"), Operator:=xlFilterValues
    ActiveWindow.LargeScroll ToRight:=1
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=29, Operator:= _
        xlFilterNoFill
    ActiveWindow.LargeScroll ToRight:=-1
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=6, Criteria1:="1"
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=7, Criteria1:="0"
    Cells.Select
    Selection.Copy
    Windows("Liste des produits publiés sans visuels.xlsx").Activate
    Sheets("ELDPH").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C11").Select
    Windows("Analyse du 100815 sur permanents CN CR.xlsx").Activate
    Rows("1:1").Select
    Application.CutCopyMode = False
    ActiveSheet.ShowAllData
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=10, Criteria1:="6"
    ActiveWindow.LargeScroll ToRight:=1
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=29, Criteria1:=RGB( _
        146, 208, 80), Operator:=xlFilterCellColor
    ActiveWindow.LargeScroll ToRight:=-1
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=6, Criteria1:="1"
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=7, Criteria1:="0"
    Cells.Select
    Selection.Copy
    Windows("Liste des produits publiés sans visuels.xlsx").Activate
    Sheets("TEXTILE").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Windows("Analyse du 100815 sur permanents CN CR.xlsx").Activate
    Rows("1:1").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=10, Criteria1:="=7", _
        Operator:=xlOr, Criteria2:="=10"
    ActiveWindow.LargeScroll ToRight:=1
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=29, Criteria1:=RGB( _
        146, 208, 80), Operator:=xlFilterCellColor
    ActiveWindow.LargeScroll ToRight:=-1
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=6, Criteria1:="1"
    ActiveSheet.Range("$A$1:$AD$71162").AutoFilter Field:=7, Criteria1:="0"
    Cells.Select
    Selection.Copy
    Windows("Liste des produits publiés sans visuels.xlsx").Activate
    Sheets("BAZAR").Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C11").Select
    Application.CutCopyMode = False

'/// ActiveWorkbook.Save (ici, je voudrais pouvoir choisir l'endroit et le nom où je l'enregistre) ///
Dim reponse
reponse = Application.GetSaveAsFilename(fileFilter:="Classeur Excel (*.xlsx), *.xlsx")
If reponse = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=reponse
'/////////////////////////////////////////////////////////////////////////////////////////////////////
    
    ActiveWorkbook.Close
    ActiveWindow.Close
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

chilo27
  • Question
Autres Simplifier une macro
Réponses
1
Affichages
256
fanch55
fanch55
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
1 K
AtTheOne
AtTheOne
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
1 K
ERIC S
ERIC S
O
  • Question
XL 2013 Macro qui sélectionne un fichier dont la fin de l'intitulé est une date qui change régulièrement
Réponses
3
Affichages
655
onyirimba
O
L
  • Question
Microsoft 365 Compter et afficher un numéro correspondant à un filtre sélectionné
Réponses
2
Affichages
1 K
Legendre
L
G
  • Question
Microsoft 365 filtrer / défiltrer insertion de ligne automatique - macro qui ne fonctionne pas ou de manière aléatoire
Réponses
4
Affichages
1 K
Grelune
G
V
  • Résolu(e)
Microsoft 365 Afficher filtres appliqués par macro dans la cellule B3 directement et non par F5 puis Réinitialiser
Réponses
12
Affichages
990
VirginieG
V
Michest94
  • Résolu(e)
XL 2016 Optimisation MACROS
2 3
Réponses
38
Affichages
4 K
Michest94
Michest94
C
  • Question
XL 2019 Pb de copier/coller dans un filtre
Réponses
4
Affichages
784
ChrisAir
C
L
  • Question
XL 2019 AIDE SUR UNE PREMIÈRE MACRO
Réponses
0
Affichages
854
lycan54
L

Membres actuellement en ligne

2 membres et 35 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 813
dernier inscrit
kaiyi