Macro pour copier tableau qui contient mot clé de Word vers Excel

Re, autant pour moi maintenant ça marche pour la colonne "Conclusion sur l’état amiantifère" je crois que mon fichier excel a eu un petit beug ja'i fermé excel et réouvert et ça marche je reverifie le code pour les noms des images.

Désolée l'euure de synthaxe pour "Dim 1Nb As Long" est tjs la!!!

une idée??

Il me semble que tu a écris "1Nb" au lieu de "lNb". Non?

Je vous ai précisé que je n'étais pas du tout douée dans le VBA.

Bonjour, merci GVIALLES pour ton aide.

J'ai une autre question au niveau de ce code la :

    Do
    Set Cel = Cells.Find(What:="NON", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
                    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
    If Cel Is Nothing Then
        Exit Do
    Else
        Rows(Cel.Row).Delete
    End If
Loop

est ce que c'est possible d'exclure les entêtes des tableaux, parce que j'ai un NON dans un entete et avec cette macro ça me le supprime !!!

Merci

Re,

ce serait encore mieux si je peux mettre une condition sur le code de l'ancien poste à savoir :

    Do
    Set Cel = Cells.Find(What:="NON", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
                    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
    If Cel Is Nothing Then
        Exit Do
    Else
        Rows(Cel.Row).Delete
    End If
Loop

Donc au lieu d'exlure les entete pour la suppression des lignes mettre plutôt une condition pour cherche le 'NON' au niveau d'une colonne specifique:

ainsi quand je lance la macro la recherche du 'NON' se fait juste au niveau de la colonne $G$2 avec le nom "Réference_prelevement" et après toutes ligne correspondantes sont supprimées.

Merci d'avance

Hajar,

Je te propose le code suivant :

     'supprimer les lignes qui ne concernent pas des pr?l?vements
    Do
        Set Cel = Cells.Find(What:="NON", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
                        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
        If Cel Is Nothing Then
            Exit Do
        Else
            'Si la cellule n'est pas dans la ligne d'entête (2) on supprime
            If Rows(Cel.Row) > 2 Then
                Rows(Cel.Row).Delete
            End If
        End If
    Loop

Pardon,

ça beug

!!!!

Re,

Etant donné que ma macro ne sera appliquée et sans risque d'effacer l'entete que dans les deux feuilles "MPCA" et "Prelevement",

j'ai essayé de rajouter ce code :

    
    'Supprimer les lignes qui ne contiennent pas de prvts dans la feuille Prelevements
    Do
    Set Cel = Worksheets("Prelevements").Cells.Find(What:="NON", LookIn:=xlFormulas, LookAt:=xlPart, _
                    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
    If Cel Is Nothing Then
        Exit Do
    Else
        Rows(Cel.Row).Delete
    End If
Loop

    'Supprimer les lignes qui ne contiennent pas de prvts dans la feuille MPCA
        Do
    Set Cel = Worksheets("MPCA").Cells.Find(What:="NON", LookIn:=xlFormulas, LookAt:=xlPart, _
                    SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
    If Cel Is Nothing Then
        Exit Do
    Else
        Rows(Cel.Row).Delete
    End If
Loop

Mais ça ne marche pas ça beug, et quand je met juste la moitié à savoir pour la feuille Prelevements ou MPCA ça ne marche que quand je suis sur la feuille en question.

est ce qu'il faut que je modifie quelque chose?

Hajar,

Il y a effectivement une erreur dans le dernier code que je t'ai proposé. Voici le bon :

     'supprimer les lignes qui ne concernent pas des prélèvements
    Do
        Set Cel = Cells.Find(What:="NON", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
                        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
        If Cel Is Nothing Then
            Exit Do
        Else
            'Si la cellule n'est pas dans la ligne d'entête (2) on supprime
            If Cel.Row > 2 Then
                Rows(Cel.Row).Delete
            End If
        End If
    Loop

Re,

je crois que je me suis mal exprimée le problème de l'ntete se situe juste dans la feuille "Reperages" et la macro doit etre appliquée dans les 2 autres feuilles "MPCA" et "Prélèvements" et la macro actuelle est realisable que pour la feuille active.

Hajar,

En espérant avoir compris ton problème, je te propose d'ajouter la procédure suivante au module :

Sub clearSheet(oSheet As Excel.Worksheet)
    Dim oCell As Excel.Range
    Do
        Set oCell = oSheet.Cells.Find(What:="NON", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, _
                SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
        If oCell Is Nothing Then
            Exit Do
        Else
            'Si la cellule n'est pas dans la ligne d'entête (2) on supprime
            If oCell.Row > 2 Then
                Rows(oCell.Row).Delete
            End If
        End If
    Loop
End Sub

et d'appeler cette procédure dans "ajoutNouvelleAttestation" :

Bonsoir navrée mais il y a quelque chose qui cloche j'ai essayé en ajouter les bouts de code que vous m'avez envoyé ça beug bizzarement (la macro reste longtemps à mouliner sans resultats)

je vous envoi le fichier excel et le word pour voir.

Hajar,

Je te renvoie le classeur corrigé.

Merci beaucoup beaucoup beaucoup

Je vais abuser mais je crois que je vais arreter après (parce que je vous prend tout votre temps)

est ce que c'est possible de m'aider pour la dernière colonne C de la feuille MPCA:

Je dois comparer les cases de la colonne Q(feuille MPCA) avec la colonne G(feuille Prélèvements) et si elles sont identiques (dans ce cas les cellules OUI P-1 ET OUI P-1 BIS) coller les infos correspondantes de la colonne E(feuille Prélèvements) dans les cases C(feuille MPCA)

pour avoir le résultat ci dessous et j'ai enlevé volontairement la ligne avec N au niveau de la colonne R ( je crois que je pourrai trouver la macro toute seule, enfin je crois!!)

Est ce qu'il y a moyen de m'aider ou j'en ai trop demandé!!!!

Merci en tous les cas

Bonjour Hajar,

Je te propose simplement de faire le même traitement dans "populateMPCA" que dans "populatePrelevement" pour déterminer le nom de l'image.

-Tu ajoutes donc "lNB" (attention! pas 1Nb... ) dans l'appel de la procédure "populateMPCA" :

-Dans le procédure "populateMPCA" tu déclares la variable "lNB" (attention! pas 1NB... ) :

Sub populateMPCA(oSheet As Excel.Worksheet, oTable2 As Word.Table, zIndex As Long, lRowReperage As Long, lNb As Long)

-Tu ajoutes le même code que dans "populatePrelevement" (en modifiant bien sûr la référence à la bonne colonne de MPCA :

               
    ' "Nom_du_fichier_image"
    Set oCell = oSheet.Cells(lRow, ThisWorkbook.Names("Nom_du_fichier_image").RefersToRange.Column)
    'On récupère le nom du fichier sans le chemin ni l'extension
    lPos1 = InStrRev(sFilename, "\")
    lPos2 = InStrRev(sFilename, ".")

    sText = Trim(Mid(sFilename, lPos1 + 1, lPos2 - lPos1 - 1)) & "-photo" & CStr(lNb - 3)
    oCell.Value = sText

Je joins mon classeur modifié.

Bonjour, est ce que c'est possible de transformer ma macro au lieu d'ouvrir les word un par un que ça me demande le dossier où se trouve tous les words et ça les ouvrent un apres l'autre automatiquement.

j'ai une macro qui fait ça mais à chaque fois que je veux l'adapter à toutes les modif que tu m'a aidé à faire ça beug.

je t'envoi le fichier excel avec la macro qui ouvre les words automatiquement.

et ENCORE UNE FOIS UN TRES GRAND MERCI A TOI GVIALLES SANS TOI MON TRAVAIL N'AURAIT PAS ABOUTI

oups j'ai oublié le fichier que voici.

(Je demande cette modification vu que j'aurai plus de 6000 word à traiter)

MERCI MERCI MERCI

Bonjour Hajar,

Je regarde ton nouveau sujet ce WE.

Bonjour Hajar,

Comme promis, je joins une nouvelle version de l'excel qui traite tous les fichiers word contenu dans un dossier choisi.