Extraction de données Excel

Bonjour,

Je viens vers vous, car je rencontre un problème d'extraction de données Excel

Nous avons plusieurs fichiers des rapports des techniciens. Les quantités des rapports peuvent varier entre 50 voir 250 semaines.

Orange nous demande de faire un suivi chaque semaine

J'utilise un fichier nommé extraction crmu qui va chercher les donnes nécessaires sur les rapports orange

Je travaille avec ce fichier d'extraction depuis quelques années.

Le problème, c'est qu'orange a modifié les fichiers crmu.

Lors de mon extraction, une fenêtre s'ouvre me bloquant les extractions

Je vous joins une capture d'écran de cette fenêtre

Ainsi que le fichier extraction et le fichier CRMU

Pour que vous puissiez mieux comprendre le problème

Je vous remercie pour votre aide

Hello,

Une piste serait de passer par PowerQuery, comme ça pas besoin d'ouvrir les fichiers des techniciens et plus de problème de avec la macro. Sinon je laisse les experts VBA dessus

Hésite pas si jamais

@+

Bonjour

Merci de me répondre, mais hélas mon niveau dans ce domaine est vraiment nul

Je vais espérer qu'un expert me réponde

encore merci

Bonjour à tous,

Pour désactiver le "MessageBox", c'est possible à l'aide de l'instruction : "Application.EnableEvents = False", puis réactiver après.

Dans la feuille "En-tête" en VBE :

Ajoute les lignes ou remplace la précédure.

Private Sub CommandButton2_Click()
    Dim WbSource As Workbook
    Dim ShEnTete As Worksheet
    Dim Chemin As String, Fichier As String
    Dim LigneEnCours As Long
    Set ShEnTete = Sheets("En tête")
    LigneEnCours = 2

    Chemin = "C:\Users\Hellali\Desktop\Extraction crmu\" 'saisir le chemin complet du dossier où se trouvent les fichiers

    Fichier = Dir(Chemin & "*.*") ' Premier fichier
    Range("A2").Select 'Sélection de la cellule A10
    Selection.Interior.ColorIndex = 2 'Arrière-plan de couleur 4
    Do While Fichier <> ""

        Application.EnableEvents = False      ' << désaciver les événements
        Set WbSource = Workbooks.Open(Filename:=Chemin & Fichier)

        With WbSource
            ShEnTete.Cells(LigneEnCours, 1) = .Sheets(1).Range("D5").Value
            ShEnTete.Cells(LigneEnCours, 2) = .Sheets(1).Range("D7").Value
            ShEnTete.Cells(LigneEnCours, 8) = .Sheets(1).Range("D37").Value
            ShEnTete.Cells(LigneEnCours, 9) = .Sheets(1).Range("D37").Value
            ShEnTete.Cells(LigneEnCours, 10) = .Sheets(1).Range("B54").Value
            .Close savechanges:=False
        End With
        Application.EnableEvents = True ' << réactiver les événements
        Set WbSource = Nothing
        LigneEnCours = LigneEnCours + 1
        Fichier = Dir ' Fichier suivant
    Loop
    Set ShEnTete = Nothing
End Sub

Biz

Tu es le meilleur Bizarre

Cela fonctionne à merveille, je te remercie vraiment de m'avoir aidée, cela me fait gagner un temps fou.

Encore merci