Extraction Word vers Excel

Le 04/12/2020 à 22:32

Bonsoir,

Je reviens vers vous pour sollicités votre aide s'il vous plait.

J'aimerais extraire une liste de mot sur le fichier doc vers Excel je vous joint les deux fichier avec les couleurs jaune sur le doc qui devrons se placer sur des cellules bien précise sur Excel .

en sachant que j'ai environs 100 fichiers doc.

J'ai la macro qui ne positionne pas correctement les écritures sur les cellules Excel

En vous remerciant

13b000000115-00000016f3-lieu-st-amand-zi.zip (16.63 Ko)

13extraction-bde.xlsm (23.09 Ko)

a extraire

Le 05/12/2020 à 10:30

Bonjour,

Un essai ...

Sub Recup()
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")
    With ShEnTete
         LigneEnCours = .Cells(Rows.Count, "A").End(xlUp).Row + 1  ''2
         Chemin = "C:\Users\Jamel\Desktop\Extraction BDE\" 'saisir le chemin complet du dossier où se trouvent les fichiers
         Fichier = Dir(Chemin & "*.*") ' Premier fichier

         Do While Fichier <> ""
            Set WbSource = Workbooks.Open(Filename:=Chemin & Fichier)
            With WbSource
                 ShEnTete.Cells(LigneEnCours, "A") = Right(.Sheets(1).Range("B2"), Len(.Sheets(1).Range("B2")) - InStr(.Sheets(1).Range("B2"), "-"))
                 .Sheets(1).Range("B6").Copy Destination:=ShEnTete.Cells(LigneEnCours, "B")
                 ShEnTete.Cells(LigneEnCours, "D") = Right(.Sheets(1).Range("A6"), Len(.Sheets(1).Range("A6")) - InStr(.Sheets(1).Range("A6"), ":"))
                 ShEnTete.Cells(LigneEnCours, "E") = Right(.Sheets(1).Range("A8"), Len(.Sheets(1).Range("A8")) - InStr(.Sheets(1).Range("A8"), ":"))
                 .Sheets(1).Range("B273").Copy Destination:=ShEnTete.Cells(LigneEnCours, "F")
                 .Close savechanges:=False
            End With
            Set WbSource = Nothing
            Fichier = Dir ' Fichier suivant
         Loop
    End With
    Set ShEnTete = Nothing
End Sub

ric

Le 05/12/2020 à 13:41

Bonjour,

Merci pour ton aide cela fonction mais j'aimerais les mètres dans les cellules a la suite 2 3 4 5...

espère me faire comprendre

Merci beaucoup vraiment sympathique

Le 05/12/2020 à 13:47

Bonjour,

Non, désolé > je ne comprends pas ...

ric

Le 05/12/2020 à 16:58

Bonjour

Désolé

je voudrais que les extractions du fichier Word puisse apparaitre dans les lignes du fichier Excel les unes en dessous des autres

A:2 B:2 D:2 E:2 F:2

A:3 B:3 D:3 E:3 F:3

A:4 B:4 D:4 E:4 F:4

Sur environs 300 lignes

Merci encore de ton aide

Le 06/12/2020 à 17:50

Bonjour,

J'ai finalement trouver ce que je chercher merci beaucoup

Mais ric tu a fait une erreur .Sheets(1).Range("B273").Copy Destination:=ShEnTete.Cells(LigneEnCours, "F") ne correspond pas a la ligne commentaire sur le fichier Word j'ai fait un copier coller du commentaire

99 Commentaire du terrain

Avenue de la république LIEU SAINT AMAND. Représentant : MR BOILEUX Tél : 03.27.35.70.00.

("B273") correspond a une date date sur le fichier Word

pouvez vous me donne s'il vous plaît le bon numéro qui correspond au commentaire

Le 06/12/2020 à 18:37

Bonjour,

En utilisant ton code départ > le fichier Word s'ouvre dans Excel et

Avenue de la république LIEU SAINT AMAND. Représentant : MR BOILEUX Tél : 03.27.35.70.00.

est bien sur la ligne 273 en colonne "B" > laquelle ligne qui était bien surlignée en jaune > comme les infos de ta demande ...

Je cite :

J'aimerais extraire une liste de mot sur le fichier doc vers Excel je vous joint les deux fichier avec les couleurs jaune sur le doc qui devrons se placer sur des cellules bien précise sur Excel .

Mais > est-ce que tu utilises bien les fichiers que tu nous as soumis pour tester ...

ric

Le 06/12/2020 à 18:42

Bonjour,

Fais un pas-à-pas (touche F8) sur le code > dès que le fichier Word est ouvert dans Excel > arrête l'exécution du code et va voir (CTRL+F) sur quelle ligne est l'info désiré ...

ric

Le 06/12/2020 à 20:03

Merci pour la reponse

Je vais regarder demain car j'ai pas le temps ce soir

Je revient vers vous demain

merci

Le 07/12/2020 à 21:15

Bonsoir Ric

Effectivement tu a raison encore et encore

je n'est pas donner le bonne information sur le précédant mail

je clôture cette demande qui ma apporter beaucoup

je tien a vous remerciez pour votre aide

Le 07/12/2020 à 21:23

ric

Le 09/12/2020 à 19:43

Bonjour,

Concerant ton souci avec rechercheV > dans la feuille "En tête" > enlève l'espace à gauche de chaque nom de site (colonne A ) ...

Ça va mieux fonctionner ...

ric

Le 09/12/2020 à 20:02

Bonsoir

Merci cela fonctionne très bien mais comment faire en sorte pour enlever tous les espaces de la colonne A même temps

En te remerciant

Le 09/12/2020 à 20:58

Bonjour,

Trim > https://docs.microsoft.com/fr-fr/office/vba/language/reference/user-interface-help/ltrim-rtrim-and-t...

Private Sub CaracteresIndesirables()
Dim Dlig As Integer
Dim Cl As Range

With Worksheets("En tête")
   Dlig = .Cells(Rows.Count, "A").End(xlUp).Row
   For Each Cl In .Range("A2:A" & Dlig)
      Cl = Trim(Cl)
   Next Cl
End With
End Sub

ric

Le 09/12/2020 à 21:11

Bonsoir

Merci encore j'ai trouver ce que je chercher sur le net pour supprimer les espaces dans la colonne A

Sub test()
Cells.Replace What:=" ", Replacement:="", LookAt:=xlPart
End Sub

Merci beaucoup a toi ric pour ton aide et m'avoir suivit

je clôture

Le 09/12/2020 à 21:15

Bonjour,

Je crois qu'il y a une différence entre Trim et Replace ...

LTrim > à gauche du texte ...

RTrim > à droite du texte ...