MsgBox si une feuille n'existe pas dans un des classeurs importés

Bonjour tout le monde, bonjour le forum,

J'ai un petit code qui importe les feuilles de tous les fichiers appartenant à un même dossier. Dans la mesure du possible il faudrait qu'une MsgBox indique que la feuille "pos" n'existe pas dans le classeur qui vient d'être ouvert par la boucle (en citant son nom dans la MsgBox) si elle n'existe pas. Concrètement, tous les classeurs appartenant au dossier DataPositions ont chacun une seule et unique feuille qui s'appelle "pos". Si il n'y a pas d'erreur le code actuel fait l'affaire en important les feuilles sur le classeur principal. Par contre si un classeur "X" n'a pas de feuille "pos" il faudrait que la MsgBox indique : "the pos has not been found for the X".

Est-ce faisable ?

Excellente journée à vous

Sub import()
Dim FileName As String
Dim Wkb As Workbook
Dim Path As String
Dim WS As Worksheet

myPath = "/Users/DataPositions/" 
myExtension = "*.xls*"
'Target Path with Ending Extention
myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
Do While myFile <> ""
'Set variable equal to opened workbook
Set Wkb = Workbooks.Open(FileName:=myPath & myFile)
'Ensure Workbook has opened before moving on to next line of code
DoEvents
'To do
For Each WS In Wkb.Worksheets
    WS.Copy , ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(Wkb.Name, ".")(0)
Next WS
'Save and Close Workbook
Wkb.Close SaveChanges:=False
DoEvents
'Get next file name
myFile = Dir
Loop
End Sub

Bonjour,

ajoute cette fonction

Function FeuilleExiste(sNomFeuille As String) As Boolean
    On Error GoTo Err_FeuilleExiste
    FeuilleExiste = False
    FeuilleExiste = Not ActiveWorkbook.Worksheets(sNomFeuille) Is Nothing
Err_FeuilleExiste:
End Function

et teste l'existence de la feuille

    If Not FeuilleExiste(Wkb.Sheets("pos")) Then
        MsgBox "La feuille ""pos"" n'existe pas dans """ & myFile & """ !"
    End If

Hello Steelson,

Merci beaucoup pour ce retour. J'ai essayé de l'intégrer dans le code ci-dessous mais il y a une erreur, tu saurais pourquoi ?

Très bonne journée

Sub Pos()

Dim FileName As String
Dim Path As String
Dim WS As Worksheet
Dim Wkb As Workbook

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

'import new sheets

myPath = "/Users/DataPositions/"
myExtension = "*.xls*"
myFile = Dir(myPath & myExtension)
Do While myFile <> ""
Set Wkb = Workbooks.Open(FileName:=myPath & myFile)
DoEvents
For Each WS In Wkb.Worksheets
If Not FeuilleExiste(Wkb.Sheets("pos")) Then
        MsgBox "La feuille ""pos"" n'existe pas dans """ & myFile & """ !"
        Else
    WS.Copy , ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(Wkb.Name, ".")(0)
    End If
Next WS
'Save and Close Workbook
Wkb.Close SaveChanges:=False
DoEvents
'Get next file name
myFile = Dir
Loop
End Sub

Function FeuilleExiste(sNomFeuille As String) As Boolean
    On Error GoTo Err_FeuilleExiste
    FeuilleExiste = False
    FeuilleExiste = Not ActiveWorkbook.Worksheets(sNomFeuille) Is Nothing
Err_FeuilleExiste:
End Function

Que dit le script ? quelle ligne en jaune ?

Sans fichier c'est toujours un peu difficile ...

Par ailleurs, y a t-il plusieurs feuilles par fichier à importer ? ce que je crois comprendre quand tu mets For Each WS In Wkb.Worksheets

Il s'agit d'une erreur d'exécution type 438; ça bloque à la ligne "If Not..........". Et il n'y a qu'une feuille par fichier importé, ça fonctionne comme ça mais serait-il préférable de changer la syntaxe ?

Merci beaucoup

Curieux

Il s'agit d'une erreur d'exécution type 438;

https://forum.excel-pratique.com/astuces/la-fameuse-erreur-438-60484


Et il n'y a qu'une feuille par fichier importé, ça fonctionne comme ça mais serait-il préférable de changer la syntaxe ?

oui, dans ce cas ce n'st pas la même syntaxe, je regarde avec un fichier de chez moi pour tester

Essaie ceci

'For Each WS In Wkb.Worksheets
If Not FeuilleExiste("pos") Then
    MsgBox "La feuille ""pos"" n'existe pas dans """ & myFile & """ !"
Else
    Wkb.Sheets("pos").Copy , ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(Wkb.Name, ".")(0)
End If
'Next WS

le for next est inutile s'il n' a qu'une seule feuille qui s'appelle pos

Hello Steelson,

J'ai l'impression que c'est à deux doigts de fonctionner mais qu'il y a un contresens dans la fonction parce que le message ("La feuille.....") apparait alors que la feuille existe bien dans les documents qui sont à importer...

Merci beaucoup pour ton aide et bonne soirée

If Not FeuilleExiste("pos") Then
    MsgBox "La feuille ""pos"" n'existe pas dans """ & myFile & """ !"
Else
    Wkb.Sheets("pos").Copy , ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(Wkb.Name, ".")(0)
End If

Function FeuilleExiste(sNomFeuille As String) As Boolean
    On Error GoTo Err_FeuilleExiste
    FeuilleExiste = False
    FeuilleExiste = Not ActiveWorkbook.Worksheets(sNomFeuille) Is Nothing
Err_FeuilleExiste:
End Function

Voici un test

donc pas de contresens a priori

Vérifie bien l'écriture du nom de l'onglet ... majuscules ? espace au début ou à la fin du nom ?

Hello Steelson,

Lorsque j'intègre ce petit code sur un document à importer, ça fonctionne bien (le message affiche bien que la feuille est disponible), donc pas de problème de nom a priori. Je pense par contre comprendre d'où vient le problème, en fait la fonction va faire le test sur la feuille active, qui au stade du If not est le fichier mère parce qu'à ce niveau on n'a pas encore ouvert/activé le premier fichier de données appartenant au dossier DataPositions. Peut-être qu'un moyen serait de faire en sorte d'ouvrir un fichier de donnée, de le tester : MsgBox vs Copy et de passer à un autre fichier de donnée et ect.

Penses-tu que c'est jouable ?

Très bonne journée

Sub pos()
myPath = "/Users/DataPositions/"
myExtension = "*.xls*"
myFile = Dir(myPath & myExtension)
Do While myFile <> ""
Set Wkb = Workbooks.Open(FileName:=myPath & myFile)
DoEvents

If Not FeuilleExiste("pos") Then
    MsgBox "La feuille ""pos"" n'existe pas dans """ & myFile & """ !"
Else
    Wkb.Sheets("pos").Copy , ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(Wkb.Name, ".")(0)
End If

Wkb.Close SaveChanges:=False
DoEvents

myFile = Dir
Loop
End Sub

Function FeuilleExiste(sNomFeuille As String) As Boolean
    On Error GoTo Err_FeuilleExiste
    FeuilleExiste = False
    FeuilleExiste = Not ActiveWorkbook.Worksheets(sNomFeuille) Is Nothing
Err_FeuilleExiste:
End Function

Je m'étais posé cette question, mais comme tu fais auparavant

Set Wkb = Workbooks.Open(FileName:=myPath & myFile)

il me semblait que tu étais sur la nouvelle feuille.

Mais le msgbox ne s'affiche que dans l'ancienne feuille. Bref pour tester, il faudrait que tu me donnes un fichier simplifié : la compil et un fichier de base.

C'est quand même plus simple avec un test

11feuille-existe.xlsm (13.90 Ko)
4source.xlsm (12.14 Ko)

Conclusion, j'aimerais bien voir les noms des onglets de ton fichier !

Oui en fait j'ai l'impression que le code s'emmêle les pinceaux au bout d'un moment dans la boucle, j'ai remarqué ça en mode pas à pas, c'est très probablement le problème. Tu trouveras ci-joint le fichier principal simplifié avec un fichier de données qui permettrait de tester le code.

Merci beaucoup pour ton aide

Je ne comprends pas ces instructions ... qu'est-ce que tu veux faire ? un nouvel onglet ?

    WS.Copy , ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(Wkb.Name, ".")(0)

Ce n'est pas repris dans la macro, quel est l'intérêt ?

Dim Path As String
Dim FileName As String

Le problème n'était pas que le msgbox, mais ta macro de copie ne fonctionnait pas ...

Sub NetPosition()

Dim Wkb As Workbook, W As Workbook
Dim WS As Worksheet, nouvelleFeuille As Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False

Set W = ThisWorkbook
'start = Timer

'Clear
'Worksheets("Aggregated").Cells.Clear
'Delete all sheets exept one
For Each WS In Application.ActiveWorkbook.Worksheets
    If WS.Name <> "Aggregated" Then
        WS.Delete
    End If
Next

'import new sheets

myPath = "/Users/DataPositions/" 'Change as needed
myExtension = "*.xls*"
myFile = Dir(myPath & myExtension)

Do While myFile <> ""

    Set Wkb = Workbooks.Open(FileName:=myPath & myFile)

    If Not FeuilleExiste("pos") Then
        MsgBox "La feuille ""pos"" n'existe pas dans """ & myFile & """ !"
    Else
        Set WS = Wkb.Sheets("pos")
        Set nouvelleFeuille = W.Sheets.Add(After:=W.Sheets(W.Sheets.Count))
        nouvelleFeuille.Name = Split(myFile, ".")(0)
        WS.Cells.Copy Destination:=nouvelleFeuille.Cells(1, 1)
    End If

    Wkb.Close SaveChanges:=False

    myFile = Dir

Loop

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

'MsgBox "DurŽe du traitement: " & Timer - start & " secondes"

End Sub

Function FeuilleExiste(sNomFeuille As String) As Boolean
    On Error GoTo Err_FeuilleExiste
    FeuilleExiste = False
    FeuilleExiste = Not ActiveWorkbook.Worksheets(sNomFeuille) Is Nothing
Err_FeuilleExiste:
End Function

Ces instructions permettent de copier la feuille et de la coller dans le fichier mère avec le nom du fichier de données (et non de la feuille pos puisque tous les fichiers de données ont une feuille qui s'appelle pos)

As-tu essayé le code ci-dessus ?

Hello Steelson,

Un grand merci pour ton aide qui m'a été précieuse pour finaliser mon projet !! Tout fonctionne parfaitement maintenant, c'est génial !

Je te souhaite d'excellentes fêtes de fin d'année

Rechercher des sujets similaires à "msgbox feuille existe pas classeurs importes"