Comparaison de X fichiers, extraction et traitement

Question

Je ne pense pas que le sujet a été traité dans son ensemble, je cherche depuis plusieurs jours, mais rien qui ne reponde a mes attente Voila, j'ai un dossier qui comporte X fichiers XLSX et je voudrais extraire de ses fichiers toutes les lignes comportant un mot que je dois saisir , ( excel doit me demander via une boite ) Une fois le mot saisi, il me crée un fichier ( ou je veux ) avec toutes les lignes comportant le mot saisi dans la boite msg Et ensuite, je dois trouver les différences entre mon extract et un fichier référence en mentionnant les lignes qui se trouve dans mon extract et pas dans le fichier référence Les fichiers comportent plusieurs feuilles Merci de me dire si cela est faisable Cordialement...

ThauThème · Answer

Oui c'est faisable avec plus de précisions : • Chemin d'accès des fichiers sources ? • les données commencent-elles toujours en A1 , avec étiquettes ou pas ? • Quel(s) onglet(s) du fichier source doi(ven)t être scanné(s) par la macro ? • Quelle(s) colonne(s) de l'onglet doi(ven)t être scannée(s) par la macro ? • Le scan se fait-il en respectant la casse (majuscule/minuscule) ou non ? • Le scan se fait-il sur la valeur entière ou sur une partie du mot ? • Le chemin d'accès du fichier Extract est fixe ou tu veux le choisir via une boîte de dialogue ? Attendant tes réponses et au moins un fichier source pour voir sa structure et son aspect.....

ThauThème · Answer

Re,

Pour le chemin d'accès des fichiers sources, tu me dis qu'il sera choisi par l'utilisateur, OK. Cela signifie que l'on travaillera sur tous les fichiers xlsx de ce dossier ?

Pour le fichier exemple j'ai juste besoin de sa structure, je me fous des données, du blabla fera très bien l'affaire...

ThauThème · Answer

Re,

En attendant de plus amples explications sur le traitement, voici la première macro pour l'extraction des données :

Sub Macro1()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim MC As Variant 'déclare la variable MC (Mot Cherchée)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim F As String 'déclare la variable F (Fichier)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim TV As Variant 'déclare la variable TV (Tableau ds valeurs)
Dim I As Long 'déclare la variable I (Incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.Worksheets(1) 'définit l'onlget destination OD
deb: 'étiquette
MC = Application.InputBox("Tapez le mot recherché !", "RECHERCHE", Type:=2) 'définit la valeur cherchée MC
If MC = False Then Exit Sub 'si bouton [Annuler], sort de la procédure
If MC = "" Then 'condition : si MC n'est pas renseignée
    MsgBox "Vous devez taper le mot recherché ou [Annuler] !" 'message
    GoTo deb 'va à l'étiquette deb
End If 'fin de la condition
MsgBox "Sélectionnez le dossier où se trouvent les fichiers source !"
With Application.FileDialog(msoFileDialogFolderPicker)
    .Show 'ouvre la boite de dialogue de sélection de dossier
    CH = .SelectedItems(1) 'définit le chemin d'accès CH (dossier sélectionné)
End With
F = Dir(CH & "\*.xlsx") 'définit le premier fichier F (.xlsx)  du dossier sélectionner
Do While F <> "" 'exécute tant que F n'est pas vide
    Workbooks.Open (CH & "\" & F) 'ouvre le fichier F
    Set CS = ActiveWorkbook 'définit le classeur source CS
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set OS = CS.Worksheets("IMPLANTATION") 'définit l'onglet source OS (génère une erreur si cet onglet n'existe pas)
    If Err <> 0 Then 'condition : si une erreur a été générée
        Err.Clear 'efface l'erreur
        CS.Close False 'ferme le classeur source sans enregistrer
        GoTo suite 'va à l'étiquette "suite"
    End If 'fin de la condition
    On Error GoTo 0 'annule la gestion des erreurs
    TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
    For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde. si il n'y a pas d'étiquette il faudra remplacer I = 2 par I = 1)
        If UCase(TV(I, 10)) = UCase(MC) Then 'condition : si la donnée ligne I colonne 10 (=> colonne J) est égale à la valeur cherchée MC
            Set DEST = IIf(OD.Range("A1") = "", OD.Range("A1"), OD.Range("A" & Application.Rows.Count).End(xlUp).Offset(1, 0)) 'définit la cellule de destination DEST
            OS.Rows(I).Copy DEST 'copie la ligne I et la colle dans DEST
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle
    CS.Close False 'ferme le classeur source sans enregistrer
suite: 'étiquette
    F = Dir 'prochain fichier du dossier sélectionné
    Erase TV 'vide le tableau de valeurs TV
Loop 'boucle sur le prochain fichier
If MsgBox("Voulez-vous enregistrer-sous ce fichier?", vbYesNo, "ENREGISTRER-SOUS") = vbYes Then 'condition : si oui au message
    Application.Dialogs(xlDialogSaveAs).Show 'ouvre la boîte de dialogue enregistrer sous
End If 'fin de la condition
End Sub

Au final, le fichier en pièce jointe, contiendra deux macros.

Mais pour la seconde, je ne comprends pas :

• Trouver les différences ? c'est pas assez clair !...

• Les fichiers comportent plusieurs feuilles ? Le fichier Extraction.xlsm que je te propose n'en comporte qu'une !...

30extraction.xlsm (18.20 Ko)