Discussion :

[anisr]

Bonjour,

J'effectue des opérations sur des fichiers (filtre, copie) et j'essaye de coller la selection sur un fichier.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Selection.CurrentRegion.Select
        Selection.Copy
        nomres = Repertoire2 & Fichier
        Workbooks.Add
        ActiveSheet.Paste
        ActiveWorkbook.SaveAs Filename:= nomres , FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False

Le but c'est d'avoir le fichier filtré enregistré sous un autre répertoir avec le même nom ainsi que l'onglet qui a le même de l'onglet du fichier initial.

[ouskel'n'or]

Les différents répertoires se trouvent-t-ils sur un même répertoire "parent" ?

[anisr]

Non le repertoir est different d'ou l'usage de Repertoire1 et Repertoire2

[ouskel'n'or]

Tu peux tester ça

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub Test()
Dim NomRep As String, NomFich As String, i As Integer
NomFich = "TonFich.xls"
With Excel.Application.FileSearch
   .NewSearch
   .LookIn = "D:\"
   .SearchSubFolders = True
   .Filename = NomFich
   If .Execute() > 0 Then
      For i = 1 To .FoundFiles.Count
         NomFich = Split(.FoundFiles(i), "\")(UBound(Split(.FoundFiles(i), "\")))
         NomRep = Replace(.FoundFiles(i), NomFich, "")
         MsgBox NomRep
      Next i
   End If
End With
End Sub

Il y a sûrement un moyen plus sioux pour obtenir le nom du répertoire une fois le fichier trouvé mais, pour le moment, je ne l'ai pas trouvé. Si quelqu'un a la solution, je ne demande qu'à apprendre

[anisr]

Je ne sais pas si c'est utile mais voila mon code complet.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Private Sub CommandButton1_Click()
Dim Repertoire1 As String, Fichier As String, Repertoire2 As String
Dim Wb As Workbook
Dim Ws As Worksheet
Dim i As Integer
 
Application.ScreenUpdating = False
 
 
'Définit le répertoire de recherche
Repertoire1 = "C:\initial\"
Repertoire2 = "C:\resultat\"
'Spécifie la recherche pour le fichiers .xls
Fichier = Dir(Repertoire1 & "*.xls")
 
 
 
'Boucle sur les fichiers du répertoire
Do While Fichier <> ""
        Fich = Repertoire1 & Fichier
        Set Wb = Workbooks.Open(Fich)
        Set Ws = Wb.Sheets(1)
        b = Ws.Range("A65536").End(xlUp).Row
        zone = "A1:J" & b
        Ws.Range(zone).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Workbooks("Console.xls").Sheets("Feuil1").Rows("1:6"), Unique:=False
        Selection.CurrentRegion.Select
        Selection.Copy
        nomres = Repertoire2 & Fichier
        Workbooks.Add
        ActiveSheet.Paste
        ChDir "C:\resultat"
        ActiveWorkbook.SaveAs Filename:= normes , FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
 
 
       'Wb.Close False
       'End If
        Fichier = Dir
Loop
 
Application.ScreenUpdating = True
MsgBox "Terminé"
 
End Sub

[ouskel'n'or]

As-tu testé le code que je t'ai passé pour voir ce qu'il donne ?
Tu dis que tu ne connais pas le répertoire et là, tu en précises deux...
Que veux-tu faire exactement ?
Dans ton code, si le fichier n'est pas dans le répertoire désigné, tu ne le trouveras pas.
Précise ta demande.
Tu as plusieurs fichiers ayant un nom identique.
Comment identifies-tu le bon fichier à ouvrir ?
Par son répertoire ?
Par le fait qu'il est déjà ouvert (...) ?
Par une date d'enregistrement ?
Tu dis
A+