Mise à jour du fichier

Le 26/06/2023 à 22:38

Bonjour,

Je me retrouve dans une situation un peu compliquer pour moi

J'ai mon client (Orange) me demande de travailler sur un nouveau fichier Excel qui se nomme CRM_U

J'ai par votre aide créer un fichier Excel nommé (Extraction crmu.xlsm) qui extrait les donnes sur le fichier d'orange (CRM_U).

Je vous remercie pour votre aide car j'ai utilisé ce fichier plus de trois ans, cela m'a vraiment été utile.

Le problème c'est que les cellules concernées à une valeur à l'intérieur qui fait que l'extraction ne se fait pas correctement.

Les donnes en D5 dans le fichier CRM_U doit être extrait dans le fichier (Extraction crmu.xlsm). De ce fait, les données n'apparaissent pas

Je vous joins les deux fichiers pour mieux comprendre le problème

Il faut créer un dossier

C:\Users\NAME\Desktop\Extraction crmu

Mettre le fichier CRM_U à l'intérieur du dossier

Utiliser le fichier Extraction crmu.xlsm en cliquant sur extraction en K1

Il faut comprendre que parfois, j'ai plus de 80 fichiers à extraire

Je vous remercie vraiment de me venir en aide

7crmu.xlsm (35.87 Ko)

6extraction-crmu.zip (348.44 Ko)

Edit modo : corrigé orthographe titre sujet

Le 27/06/2023 à 05:53

Bonjour

Ci joint ma solution...

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\Jamel\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 <> ""
            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("D33").Value
                 ShEnTete.Cells(LigneEnCours, 9) = .Sheets(1).Range("D33").Value
                 ShEnTete.Cells(LigneEnCours, 10) = .Sheets(1).Range("B48").Value
                 .Close savechanges:=False
            End With
            Set WbSource = Nothing
            LigneEnCours = LigneEnCours + 1
            Fichier = Dir ' Fichier suivant
         Loop
    Set ShEnTete = Nothing
End Sub

A+ François

Le 27/06/2023 à 13:59

Bonjour François,

Merci beaucoup de ton retour, cela fonctionne très bien.

Mais, à chaque extraction, une casse s'ouvre et me demande une mise ajour, une fois que je clique sur mise ajour une autre casse s'ouvre, me demande de continuer

Je vous joins les deux captures d'écran

pour mieux comprendre, cela pour chaque extraction avec plus de 80 fichiers

peut-on détourner ce problème ?

Merci beaucoup de ton aide

Le 27/06/2023 à 15:30

J'ai supprimé toutes les liaisons

6extraction-crmu.zip (347.72 Ko)

A+ François

Le 27/06/2023 à 15:39

Bonjour,

Rapide la réponse merci beaucoup

Hélas les deux fenêtres s'ouvrent toujours comme dans les captures d'écran

Merci

Le 27/06/2023 à 16:31

le mien ne le fait pas?

A+ François

Le 28/06/2023 à 13:06

Bonjour François

Merci d'avoir pris le temps de résoudre mon problème

Tu pense que le problème peut venir d'où ??

Merci

Le 28/06/2023 à 13:27

Bonjour

Ca vient d'une liaison que je n'ai pas

essaie cette macro

Sub SupprimerLiaisons()
'par Excel-Malin.com ( https://excel-malin.com/ )
Dim Liaisons As Variant
Liaisons = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)

If IsEmpty(Liaisons) = True Then Exit Sub

For LiaisonsTrouvee = 1 To UBound(Liaisons)
ActiveWorkbook.BreakLink _
    Name:=Liaisons(LiaisonsTrouvee), _
    Type:=xlLinkTypeExcelLinks
Next LiaisonsTrouvee
End Sub

A+ François

Le 28/06/2023 à 21:56