Autres Sélectionnez la feuille ayant le même nom dans un autre classeur

[Lhomheureux]

Bonjour à tous.
J'aimerais que vous m'aidiez à corriger quelques lignes de mon code. J'ai essayé mais je n'y arrive pas.

Sub SelectionFeuilleCorrespondante()

'0- Déclaration des variables
Dim Feuil As Worksheet
Dim i As Integer
Dim NomFeuil As String
Dim FichierDefaillant As String
Dim FichierEncaissement As String
Dim WBKSource1 As Workbook
Dim WBKSource2 As Workbook

'1- Sélection de la première feuille du classeur CLIENTS

For i = 3 To Sheets.Count 'décompte des feuilles dans CLIENTS

ActiveWorkbook.Sheets(i).Select 'SOUCIS : la sélection de la feuille (i) ne se fait pas à partir de la feuille 3 mais de la feuille active du classeur.
'Comment faire pour que se soit la première feuille (la feuille 3) qui soit sélectionné en premier ?
NomFeuil = ActiveSheet.name
Range("A1:A3").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.UnMerge
Range("B4").Select

'2- Ouverture du classeur ENCAISSEMENT
Workbooks.Open (FichierEncaissement)

'ERREUR A CORRIGER: Si la feuille recherché n'existe pas dans le classeur ENCAISSMENT
'on poursuit la procédure en recommençant sur une autre feuille(i) au point 1 du classeur CLIENT
ActiveWorkbook.Sheets(NomFeuil).Select 'choisir la feuille qui a le même nom que celle sélectionnée dans CLIENTS
Range("A1").CurrentRegion.Select
Selection.Copy

'3- Ouvrir le classeur CLIENTS et copie des données
WBKSource2.Activate
Sheets(NomFeuil).Select
Range("B4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(3, 0).Range("A1").Select
ActiveSheet.Paste
ActiveCell.Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.AutoFilter
ActiveCell.CurrentRegion.RemoveDuplicates Columns:=2, Header:=xlYes
Selection.AutoFilter

Next

End Sub


PS : Désolé, je ne sais pas copier-coller pour que cela apparaisse ici comme dans la feuille de code du VBA excel, avec les couleurs et tout.

 

[Robert]

Bonjour Lhomheureux, bonjour le forum,

La règle d'or en VBA c'est d'éviter autant que tu le peux les Select et autre Activate inutiles. Ils ne font que ralentir l'exécution du code et sont source de nombreux bugs. Ceci-dit, quand on travaille sur des classeurs et onglet différents il faut toujours spécifier le classeur et l'onglet quand on veut utiliser une cellule ou plage de ceux-ci. Désolé j'ai renommé tes variables car ces noms à rallonge je ne m'y fais pas...
Pas sûr d'avoir bien retranscrit ton code car sans le fichier difficile de savoir où l'on va... Seul problème pour moi c'est la variable FE (FichierEncaissement) qui n'est définie nulle-part !?...
Le code :

Sub SelectionFeuilleCorrespondante()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim FE As String 'déclare la variable FE (FichierEncaissement)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim I As Integer 'déclare la variable I (Incrément)
Dim NO As String 'déclare la variable NO (Nom Onglet)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CS = ThisWorkbook 'définit le classeur source CS
Set CD = Workbooks.Open(FE) 'FE n'est définit nulle part, je vois mal comment il va s'ouvrir
For I = 3 To CS.Sheets.Count 'boucle sur tous les onglets du classeur source (en partant du troisième)
    Set OS = CS.Sheets(I) 'définit l'onglet source OS
    NO = OS.Name 'récupère le nom dans la variable NO
    OS.Range("A1:A" & OS.Cells(1, Application.Columns.Count).End(xlToLeft).Column).UnMerge 'défusionne la première ligne
    OS.Activate 'active l'onglet 'on aurait pu se passer de cette ligne
    OS.Range("B4").Select 'sélectionne B4 'on aurait pu se passer de cette ligne
    On Error Resume Next 'gestion des errurs (en cas d'erreur pase à la ligne suivante)
    Set OD = CD.Worksheets(NO) 'définit l'onglet destination OD (onglet ayant NO comme nom dans le classeur destination CD, génère une erreur si l'onglet n'existe pas)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'supprime l'erreur
        GoTo suite 'va à l'étiquette suite
    End If 'fin de la condition
    On Error GoTo 0 'fin de la gestion des erreurs
    Set DEST = OS.Cells(Application.Rows.Count, "B").End(xlUp).Offset(3, 0) 'définit la cellule de destination DEST
    OD.Range("A1").CurrentRegion.Copy DEST 'copie la plage des cellules adjacentes à A1 de l'onglet destination de la colle dans DEST
    Application.CutCopyMode = False 'supprime le clignotement du [COPIER]
    Range(DEST, DEST.End(xlToRight)).AutoFilter 'supprime le filtre automatique (???)
    DEST.CurrentRegion.RemoveDuplicates Columns:=2, Header:=xlYes 'supprime les doublons de la colonne 2
Range(DEST, DEST.End(xlToRight)).AutoFilter 'supprime encore le filtre automatique (???)
suite: 'étiquette
Next I 'prochain onglet de la boucle
End Sub

 

[Lhomheureux]

Merci Robert pour ton aide. Je teste ton code tout de suite. Ceci dit, comment tu fais pour coller le code comme tu l'as fait de sorte qu'il paraisse comme dans le VBE?

 

[Robert]

Re,

Ha oui j'avais oublié. Il faut faire comme Linda, utiliser les valises. Heu pardon les balises... Clique sur le symbole </>. Là, tu colles le code... ou, (j'ai mis un espace après le [ et un autre avant le ] pour les désactiver. Il te faudra les supprimer ces espaces pour que ça marche)
1. tu tapes : [ CODE=vb ] (ouverture de la balise)
2. tu colles le code
2. tu tapes [ /CODE ] (fermeture de la balise)

 

[Lhomheureux]

J'ai essayé de me servir de ta gestion des erreurs qui fonctionne...jusqu'à une étape.
Pour le code, effectivement sans la variable "fichier encaissement (FE)" et la variable "fichier défaillants" (tu ne l'as pas définit dans ton code), ça beug un peu et je crois qu'il y a quelques lignes qui devront être ajoutés ou supprimés.

Voici le début de mon code où je définit ces variables. En fait, ce sont les noms (d'où le string) des deux classeurs (CS et CD) que moi je nomme respectivement WBKsource1 et WBKsource2.

'2- Selection des fichiers sources
With Application.FileDialog(msoFileDialogOpen)
   .Title = "Choix du Fichier"
    .Filters.Clear
    .Filters.Add "Ton Tableur", "*.xlsX*, *.Xlsm*, *.Xls*"
    .AllowMultiSelect = False
    
    MsgBox "Sélectionnez le fichier des ENCAISSEMENTS!"
        If .Show <> 0 Then
        FichierEncaissement = .SelectedItems(1)
            Set WBKSource1 = Workbooks.Open(FichierEncaissement)
                Else
    MsgBox "Le tri des défaillants ne peut se faire sans sélection du fichier demandé!", , "LhomHeureux pour vous servir!": Exit Sub
        End If
    
    MsgBox "Sélectionnez votre fichier des CLIENTS"
        If .Show <> 0 Then
        FichierDefaillant = .SelectedItems(1)
            Set WBKSource2 = Workbooks.Open(FichierDefaillant) 'ouvre le fichier sélectionné
                Else
    MsgBox "Le tri des défaillants ne peut se faire sans sélection du fichier demandé!", , "LhomHeureux pour vous servir!": Exit Sub
        End If
End With

 

[Robert]

Re,

J'ai rectifié le code en intégrant le tien. Mais sans les fichiers il me sera difficile de faire plus :
Le code :

Sub SelectionFeuilleCorrespondante()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim FE As String 'déclare la variable FE (FichierEncaissement)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim I As Integer 'déclare la variable I (Incrément)
Dim NO As String 'déclare la variable NO (Nom Onglet)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

With Application.FileDialog(msoFileDialogOpen)
    .Title = "Choix du Fichier"
    .Filters.Clear
    .Filters.Add "Ton Tableur", "*.xlsX*, *.Xlsm*, *.Xls*"
    .AllowMultiSelect = False
    MsgBox "Sélectionnez le fichier des ENCAISSEMENTS!"
    If .Show <> 0 Then
        FichierEncaissement = .SelectedItems(1)
        Set CS = Workbooks.Open(FichierEncaissement)
    Else
        MsgBox "Le tri des défaillants ne peut se faire sans sélection du fichier demandé!", , "LhomHeureux pour vous servir!": Exit Sub
    End If
    MsgBox "Sélectionnez votre fichier des CLIENTS"
    If .Show <> 0 Then
        FichierDefaillant = .SelectedItems(1)
        Set CD = Workbooks.Open(FichierDefaillant) 'ouvre le fichier sélectionné
    Else
        MsgBox "Le tri des défaillants ne peut se faire sans sélection du fichier demandé!", , "LhomHeureux pour vous servir!": Exit Sub
    End If
End With
For I = 3 To CS.Sheets.Count 'boucle sur tous les onglets du classeur source (en partant du troisième)
    Set OS = CS.Sheets(I) 'définit l'onglet source OS
    NO = OS.Name 'récupère le nom dans la variable NO
    OS.Range("A1:A" & OS.Cells(1, Application.Columns.Count).End(xlToLeft).Column).UnMerge 'défusionne la première ligne
    OS.Activate 'active l'onglet 'on aurait pu se passer de cette ligne
    OS.Range("B4").Select 'sélectionne B4 'on aurait pu se passer de cette ligne
    On Error Resume Next 'gestion des errurs (en cas d'erreur pase à la ligne suivante)
    Set OD = CD.Worksheets(NO) 'définit l'onglet destination OD (onglet ayant NO comme nom dans le classeur destination CD, génère une erreur si l'onglet n'existe pas)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'supprime l'erreur
        GoTo suite 'va à l'étiquette suite
    End If 'fin de la condition
    On Error GoTo 0 'fin de la gestion des erreurs
    Set DEST = OS.Cells(Application.Rows.Count, "B").End(xlUp).Offset(3, 0) 'définit la cellule de destination DEST
    OD.Range("A1").CurrentRegion.Copy DEST 'copie la plage des cellules adjacentes à A1 de l'onglet destination de la colle dans DEST
    Application.CutCopyMode = False 'supprime le clignotement du [COPIER]
    Range(DEST, DEST.End(xlToRight)).AutoFilter 'supprime le filtre automatique (???)
    DEST.CurrentRegion.RemoveDuplicates Columns:=2, Header:=xlYes 'supprime les doublons de la colonne 2
Range(DEST, DEST.End(xlToRight)).AutoFilter 'supprime encore le filtre automatique (???)
suite: 'étiquette
Next I 'prochain onglet de la boucle
End Sub

 

[Lhomheureux]

Merci Robert pour ton aide. J'ai pu adapter et corriger mon code. Il fonctionne maintenant comme il se doit.