Activer un classeur déja ouvert avec le début du nom

[Hellhand]

Bonjour à tous,

j'ai un petit souci je n'arrive pas à activer un fichier déja ouvert avec le début du nom.

j'arrive à l'ouvrir dans le repertoire mais pour l'activé le programme bloque.

voici le programme:


programme qui ouvrir le fichier dans le repertoire avec le début du nom du fichier "SuiviCND"

Sub Ouvrir_fiche_qualité_et_triée()
Application.ScreenUpdating = False
Dim ChercheFichier As FileSearch
Dim Chemin As String
Dim I As Integer
Dim debut
Dim ouvr
Dim wb As Workbook
Dim ws As Worksheet


On Error Resume Next

Set ChercheFichier = Application.FileSearch
Chemin = "E:\TRS\Indicateurs de performances\données\" ' a adapter selon emplacement
With ChercheFichier
.NewSearch
.Filename = "*.xls"
.LookIn = Chemin
.SearchSubFolders = False
.Execute msoSortByFileName, msoSortOrderAscending
If .Execute > 0 Then

With .FoundFiles

For I = 1 To .Count
debut = Left(Dir(.Item(I)), 8)

If debut = "SuiviCND" Then
' a adapter selon emplacement repertoire
Workbooks.Open ("E:\TRS\Indicateurs de performances\données\" & Dir(.Item(I)))
Set ws = wb.Worksheets(1)
    Selection.AutoFilter Field:=3, Criteria1:="=121", Operator:=xlOr, _
        Criteria2:="=*121*"
     Application.ScreenUpdating = True
End If

Next I
End With
End If
End With

End Sub

le programme dans lequelle je dois activé le classeur avec le début du nom du classeur"SuiviCND"
le problème se situe au milieu

 'après avoir selectionné le mois dans tri automatique importer donneées de la feuille sans modification
Sub Importer_donner()
Application.ScreenUpdating = False
Sheets("Fiche de saisie").Unprotect
Dim wb As Workbook
Dim ws As Worksheet
 





For Each wb In Workbooks
    If LCase(wb.Name) Like "SuiviCND" Then wb.Activate: Exit For
Next wb 





Selection.SpecialCells(xlCellTypeVisible).Select

    Columns("M:N").Copy
    Windows("Potence sous flux SAF.xls").Activate
    Range("C98").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Application.CutCopyMode = False
    Set ws = wb.Worksheets(1)
       Range("D15").Select
    

Sheets("Fiche de saisie").Protect
Application.ScreenUpdating = True
End Sub

Help me please

 

[mikachu]

Re : Activer un classeur déja ouvert avec le début du nom

Bonjour,

Au lieu de "For Each wb In Workbooks", essaie avec "For Each wb In Application.Workbooks"
ça devrait mieux fonctionner
Si non, il doit y avoir un problème avec le "like" j'y regarde
mikachu

Edit: le problème vient du like.
If LCase(wb.Name) Like "SuiviCND" Then wb.Activate: Exit For
à modifier en
If LCase(wb.Name) Like "SuiviCND*" Then wb.Activate: Exit For

 

[Papou-net]

Re : Activer un classeur déja ouvert avec le début du nom

Bonjour Hellhand, mikachu,

Pour rebondir sur ta proposition,mikachu, il faudrait essayer comme ceci :

If LCase(wb.Name) Like "SuiviCND*" Then wb.Activate: Exit For

Espérant avoir aidé.

Cordialement.

 

[mikachu]

Re : Activer un classeur déja ouvert avec le début du nom

Bonjour Papou-net.

Exact ! j'étais en train d'éditer mon message

 

[Hellhand]

Re : Activer un classeur déja ouvert avec le début du nom

ok pour commencer merci de vos réponse, je vais tester ca.

 

[Hellhand]

Re : Activer un classeur déja ouvert avec le début du nom

euh j'ai un soucie le bout de code ne marche pas, le classeur ne s'active pas il fait comme si il travaillait toujours sur le même classeur.

'après avoir selectionné le mois dans tri automatique importer donneées de la feuille
Sub Importer_donner()
Application.ScreenUpdating = False
Sheets("Fiche de saisie").Unprotect
Dim wb As Workbook
Dim ws As Worksheet



For Each wb In Application.Workbooks
    If LCase(wb.Name) Like "SuiviCND*" Then wb.Activate: Exit For
Next wb



     Selection.SpecialCells(xlCellTypeVisible).Select
    Columns("M:N").Copy
    Windows("Potence sous flux SAF.xls").Activate
    Range("C98").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
   Application.CutCopyMode = False
       Range("D15").Select
    

Sheets("Fiche de saisie").Protect
Application.ScreenUpdating = True
End Sub