Vba Problème d'enchainement d'instruction

Arpette

XLDnaute Impliqué
Bonjour à toutes et à tous,

J'ai problème avec ma macro, quand je cliques un le bouton enregister, je veux qu'elle s'exécute avec le code du module 4 et qu'elle ferme le classeur. J'ai également du code sur la feuille 1 qui fonctionne quand je l'utilise pour ma rechercheV.
Le problème est, que si je cliques sur enregistrer, le code se déroule correctement, mais il enchaine sur la feuille 1, il ouvre le fichier "Mes Clients" et ensuite j'ai un message comme quoi "Windows("APPARAUX.xls").Activate" l'indice n'appartient pas à la sélection. D'où mes questions :
pourquoi à l'enregistrement mon classeur ne se ferme pas et pourquoi quand il enchaine sur la feuille 1, j'ai une erreur.
Merci de votre aide.

Code:
Sub Enregister()
    ' Enregistrer Sous
    
    Dim Lechemin As String
    Dim LeFichier As String
    Dim NomRep As String
    
   '\***************************************************************************************************************************
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Lechemin = ActiveWorkbook.Path
            
    Nom = Cells(4, 3)
        
    NomClient = Cells(35, 11).Value
    
    NomRep = NomClient
    
    Marque = Cells(9, 8).Value
    
    Numserie = Cells(11, 8).Value
              
    Jour = Format(Cells(45, 9), "dd-MM-YYYY")
    
    LeFichier = Nom & " _ " & NomClient & " _ " & Marque & " _ " & Numserie & " _ " & Jour
   '\***************************************************************************************************************************
    Lechemin = "C:\Documents and Settings\JFL CONTROLE\Bureau\Trames\CONTROLES CLIENTS\"
    
    If Dir(Lechemin & NomRep, 16) = "" Then MkDir Lechemin & NomRep
       
    ActiveWorkbook.SaveAs Lechemin & NomRep & "\" & LeFichier

    ActiveWorkbook.ActiveSheet.Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
   '\***************************************************************************************************************************
        ThisWorkbook.Close SaveChanges:=True
   '\***************************************************************************************************************************
    Application.ScreenUpdating = True
End Sub
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Intersect(Target, Range("K35:Z35")) Is Nothing Then Exit Sub

    Dim rng As Range
    Dim Clients As Worksheet
    Dim x As Range
    Dim Lechemin As String
    Dim MonClasseur As Excel.Workbook
    Dim WB1 As Workbook
    
    Set WB1 = ThisWorkbook
    Lechemin = "C:\Documents and Settings\JFL CONTROLE\Bureau\Mes Clients\Mes Clients"

    Set MonClasseur = Excel.Workbooks.Open(Lechemin)
    Windows("APPARAUX.xls").Activate 'Cest ici que j'ai l'erreur quand j'utilise la macro précédente
    Worksheets("Page 1").Select
    Set rng = Worksheets("Page 1").Range("K35")
    Set Clients = MonClasseur.Sheets("Feuil1")
        Set x = Clients.Columns("A:G").Find(Range("K35").Value, , xlValues, xlWhole, , , False)
        If Not x Is Nothing Then
            Range("K36").Value = x.Offset(0, 1).Value
            Range("I37").Value = x.Offset(0, 2).Value
            Range("I38").Value = x.Offset(0, 3).Value
            Range("I39").Value = x.Offset(0, 4).Value
            Range("K41").Value = x.Offset(0, 5).Value
            Range("K42").Value = x.Offset(0, 6).Value
            
       If Range("K35") = "" Then
            Range("K36").Value = ""
            Range("I37").Value = ""
            Range("I38").Value = ""
            Range("I39").Value = ""
            Range("K41").Value = ""
            Range("K42").Value = ""
        End If

    Set rng = Worksheets("Page 1").Range("Z35")
    Set Clients = MonClasseur.Sheets("Feuil1")
    Set x = Clients.Columns("A:G").Find(Range("Z35").Value, , xlValues, xlWhole, , , False)
        If Not x Is Nothing Then
            Range("Z36").Value = x.Offset(0, 1).Value
            Range("X37").Value = x.Offset(0, 2).Value
            Range("X38").Value = x.Offset(0, 3).Value
            Range("X39").Value = x.Offset(0, 4).Value
            Range("Z41").Value = x.Offset(0, 5).Value
            Range("Z42").Value = x.Offset(0, 6).Value
        If Range("Z35") = "" Then
            Range("X36").Value = ""
            Range("X37").Value = ""
            Range("X38").Value = ""
            Range("X39").Value = ""
            Range("Z41").Value = ""
            Range("Z42").Value = ""
        End If

 MonClasseur.Close

Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End If
End Sub
 

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG