MACRO Test existance feuille - RESOLU -

G

guez

XLDnaute Nouveau
Bonjour,

J'ai parcouru les posts traitant de ce sujet mais je n'arrive pas à intégrer le code à ma macro.

La macro ci-dessous fonctionne parfaitement sauf lorsqu'elle rencontre un fichier qui n'a pas de feuille nommé "PARAMETRES" ou là elle plante.

J'ai besoin que: SI la classeurs qu'elle ouvre contient une feuille nommé "PARAMETRES" la macro continue, SINON elle ferme le classeurs et passe au suivant.

Merci pour votre aide.

Code: 
Sub recup()
 'Parametre d'importation
ThisWorkbook.Activate
Dim Source As String
 
ligne = 1 'ligne d'ecriture
colonne = 1 ' colonne d'ecriture
 
For n = 19 To 50
 
Source = Sheets("PARAMETRESIMPORT").Range("K" & n)
Chemin = Source ' chemin d'accés
fichier = Dir(Chemin & "*????-????-??.xls")

Do While fichier <> ""
Workbooks.Open Filename:=Chemin & fichier
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

 
'localisation des données à extraire
Dim Effectif As String, NumGestion As String
Effectif = Sheets("BALANCE").Range("D89")
NumGestion = Sheets("PARAMETRES").Range("D9")
     
'Extraction des données
ThisWorkbook.Sheets("AjoutEffectif").Activate

 
Cells(ligne, colonne) = NumGestion
Cells(ligne, colonne + 1) = Effectif
ligne = ligne + 1
Windows(fichier).Close savechanges:=False ' fermeture du fichier sources sans enregistrer les changements
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
fichier = Dir ' Fichier suivant
Loop
 
Next
 End Sub


Explication du code existant:
Chaque mois, la macro va chercher 2 données dans environs 1000 fichiers répartit sur une trentaine de dossier
 
Dernière édition:
Trier par date Trier par votes
Robert

Robert

XLDnaute Barbatruc
Repose en paix
Re : MACRO Test existance feuille

Bonjour Guez, bonjour le forum,

Peut-être comme ça (non testé) :
Code: 
Sub recup()
 'Parametre d'importation
ThisWorkbook.Activate
Dim Source As String
 
ligne = 1 'ligne d'ecriture
colonne = 1 ' colonne d'ecriture
 
For n = 19 To 50
    Source = Sheets("PARAMETRESIMPORT").Range("K" & n)
    Chemin = Source ' chemin d'accés
    fichier = Dir(Chemin & "*????-????-??.xls")
    
    Do While fichier <> ""
        Workbooks.Open Filename:=Chemin & fichier
        Application.DisplayAlerts = False
        Application.AskToUpdateLinks = False
        
         
        'localisation des données à extraire
        Dim Effectif As String, NumGestion As String
        Effectif = Sheets("BALANCE").Range("D89")
        On Error Resume Next
        NumGestion = Sheets("PARAMETRES").Range("D9")
        If Err <> 0 Then
            Err = 0
            GoTo suite
        End If
        On Error GoTo 0
        'Extraction des données
        ThisWorkbook.Sheets("AjoutEffectif").Activate
        
         
        Cells(ligne, colonne) = NumGestion
        Cells(ligne, colonne + 1) = Effectif
        ligne = ligne + 1
        Windows(fichier).Close savechanges:=False ' fermeture du fichier sources sans enregistrer les changements
        ThisWorkbook.Activate
        Range("A65536").End(xlUp).Offset(1, 0).Select
suite:
        On Error GoTo 0
        fichier = Dir ' Fichier suivant
    Loop
Next
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
G

Guest

Guest
Re : MACRO Test existance feuille

Bonjour,

Code: 
Sub recup()
'Parametre d'importation
    ThisWorkbook.Activate
    Dim Source As String
    ligne = 1    'ligne d'ecriture
    colonne = 1    ' colonne d'ecriture
    For n = 19 To 50
        Source = Sheets("PARAMETRESIMPORT").Range("K" & n)
        Chemin = Source    ' chemin d'accés
        fichier = Dir(Chemin & "*????-????-??.xls")
        Do While fichier <> ""
            Workbooks.Open Filename:=Chemin & fichier
            Application.DisplayAlerts = False
            Application.AskToUpdateLinks = False
            Dim shParams As Worksheet
            On Error Resume Next
            Set shParams = Sheets("PARAMETRES")
            On Error GoTo 0
            If Not shParams Is Nothing Then
                'localisation des données à extraire
                Dim Effectif As String, NumGestion As String
                Effectif = Sheets("BALANCE").Range("D89")
                NumGestion = shParams.Range("D9")
                'Extraction des données
                ThisWorkbook.Sheets("AjoutEffectif").Activate

                Cells(ligne, colonne) = NumGestion
                Cells(ligne, colonne + 1) = Effectif
                ligne = ligne + 1
            End If
            Windows(fichier).Close savechanges:=False    ' fermeture du fichier sources sans enregistrer les changements
            ThisWorkbook.Activate
            Range("A65536").End(xlUp).Offset(1, 0).Select
            fichier = Dir    ' Fichier suivant
        Loop
    Next
End Sub

A+

[edit] Bing! Salut Robert:)
 
Vote positif 0 Vote négatif
pierrejean

pierrejean

XLDnaute Barbatruc
Re : MACRO Test existance feuille

Bonsoir guez

A tester:

Code: 
Sub recup()
 'Parametre d'importation
ThisWorkbook.Activate
Dim Source As String
 
ligne = 1 'ligne d'ecriture
colonne = 1 ' colonne d'ecriture
 
For n = 19 To 50
 
Source = Sheets("PARAMETRESIMPORT").Range("K" & n)
Chemin = Source ' chemin d'accés
fichier = Dir(Chemin & "*????-????-??.xls")


Do While fichier <> ""
Workbooks.Open Filename:=Chemin & fichier
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False


 
'localisation des données à extraire
Dim Effectif As String, NumGestion As String
Effectif = Sheets("BALANCE").Range("D89")


On Error GoTo suite
  NumGestion = Sheets("PARAMETRES").Range("D9")
'Extraction des données
 ThisWorkbook.Sheets("AjoutEffectif").Activate
 Cells(ligne, colonne) = NumGestion
 Cells(ligne, colonne + 1) = Effectif
 ligne = ligne + 1
suite:
On Error GoTo 0
Windows(fichier).Close savechanges:=False ' fermeture du fichier sources sans enregistrer les changements
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select


fichier = Dir ' Fichier suivant
Loop
 
Next
 End Sub

Edit : Salut Robert Salut Hasco
 
Dernière édition:
Vote positif 0 Vote négatif
G

guez

XLDnaute Nouveau
Re : MACRO Test existance feuille

Je n'ai essayé que le code de Pierre Jean car je le comprenais, ce qui n'était pas le cas de vos propositions Hasco et Robert :(
J'ai fais une ptite modif car l'inexistance de de la feuille "balance" fait aussi planter la macro. En fait, si les feuilles "balance" ou "parametres" n'existent pas c'est que le fichier n'est pas à prendre en compte.

Voici donc mon code (cela pourra certainement aider d'autres personnes).

Merci à vous 3!

Code: 
Sub recup()
 'Parametre d'importation
ThisWorkbook.Activate
Dim Source As String
 
ligne = 1 'ligne d'ecriture
colonne = 1 ' colonne d'ecriture
 
For n = 19 To 50
 
Source = Sheets("PARAMETRES").Range("K" & n)
Chemin = Source ' chemin d'accés
fichier = Dir(Chemin & "*????-????-??.xls")

Do While fichier <> ""
Workbooks.Open Filename:=Chemin & fichier
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
 
'localisation des données à extraire
Dim Effectif As String, NumGestion As String

On Error GoTo suite 'si les feuilles n'existent pas, ne rien faire et passer à la suite
Effectif = Sheets("BALANCE").Range("D89")
NumGestion = Sheets("PARAMETRES").Range("D9")
'Extraction des données
ThisWorkbook.Sheets("AjoutEffectif").Activate
Cells(ligne, colonne) = NumGestion
Cells(ligne, colonne + 1) = Effectif
ligne = ligne + 1
suite:
On Error GoTo 0
Windows(fichier).Close savechanges:=False ' fermeture du fichier sources sans enregistrer les changements
ThisWorkbook.Activate
Range("A65536").End(xlUp).Offset(1, 0).Select
 

fichier = Dir ' Fichier suivant
Loop
 
Next
 End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
229
Francky79
F
V
  • Résolu(e)
XL 2016 Facturier : Retour à la ligne sur la facture
2
Réponses
19
Affichages
641
Vermithor
V
V
  • Résolu(e)
XL 2016 Exportation au format PDF à l'aide d'une macro : erreur 1004 'Document non enregistré'
Réponses
14
Affichages
611
Phil69970
Phil69970
luke3300
  • Question
Microsoft 365 Erreur de macro
Réponses
4
Affichages
563
luke3300
luke3300
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
144
marie3107
M
F
  • Question
XL 2016 copier des fichiers dans des sous dossiers a partir de case a cocher sous excel
2
Réponses
17
Affichages
650
Felipe54
F
T
  • Question
XL 2016 Code VBA sous un macos
Réponses
4
Affichages
303
telemarrk
T
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
200
marie3107
M
Q
  • Résolu(e)
Microsoft 365 Exécutions directes différentes vs "pas à pas"
Réponses
2
Affichages
267
Quentin2106
Q
L
  • Résolu(e)
Microsoft 365 Pb de valeur de variable entre Sub
Réponses
5
Affichages
239
loreak
L

Membres actuellement en ligne

12 membres et 146 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 488
Messages
2 088 862
Membres
103 979
dernier inscrit
imed