Microsoft 365 Transfert de données d'un classeur vers un autre

L

lolo_excelbeginner

XLDnaute Nouveau
Bonjour à tous,

J'ai grand besoin d'aide.

J'ai créé un fichier me permettant des synthétiser des données que je récupère à partir d'un autre fichier que je télécharge !

Mon problème et que j'aimerais transférer les données du fichier téléchargé dans le fichier que j'ai créé.

Problème, le fichier que je télécharge contient des chiffres en "texte", il faudrait donc réussir à entièrement convertir le fichier en chiffre pour pouvoir faire des calculs plus tard.

Ensuite, je souhaiterais faire une "rechercheV" en VBA afin de remplir les cases "jaunes" de mon "fichier" à remplir.. Et là est mon grand problème, je me perds dans la syntaxe..

"Fichier téléchargé"
1674825361860.png


"Fichier à remplir"
1674825436096.png


En fait, Je souhaiterais que si le nombre contenu dans la colonne X (fichier à téléchargé), est égal au chiffre de la colonne E (fichier à remplir)r, la valeur de la case jaune ("fichier téléchargé) soit égale à la valeur de la case jaune (fichier à remplir).

J'ai déjà une macro qui me permet d'ouvrir un fichier. Il faudrait que la future macro prenne en argument ce fichier, car le nom du fichier changera régulièrement...
Le "fichier à remplir" à une forme fixe également, les lignes "E" , "EEE" etc. sont des séparateurs que je ne pourrais pas supprimer...

J'espère avoir été clair, si ce n'est pas le cas n'hésitez pas à me demander des précisions..

Merci d'avance à tous !

Cordialement,

LOLO
 

Pièces jointes

  • Fichier à remplir.xlsm
    96.1 KB · Affichages: 5
  • Fichier_téléchargé.xls
    43.5 KB · Affichages: 6
Dernière édition:
Solution
cathodique
Bonsoir,

à tester. Bonne soirée.
VB: 
Option Explicit
Sub Transfert()
   Dim Ancien As Workbook, MonFichier As Workbook, NomFichier As String, X As Variant
   Dim Fichier As String, Tf, i As Long, item, dl As Long, Plage As Range
   Set MonFichier = ThisWorkbook
  
Tf = Array("Série 6000 2019 C", "Série (B)2000 2019 B") 'feuilles concernées dans un array pour faire une boucle
 
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False

'fermer tous les fichiers excel sauf le concerné
   For Each Ancien In Application.Workbooks
      If Not (Ancien Is Application.ThisWorkbook) Then
         Ancien.Close
      End If
   Next
'-----------------------------------------------------------
   'invite ouverture fichier...
Trier par date Trier par votes
L

lolo_excelbeginner

XLDnaute Nouveau
J'essaye de faire quelque chose comme ça, mais je manque de connaissance..et ça ne fonctionne évidemment pas...

Sub Transfert()
Dim Ancien As Workbook
Dim Fichier As String
Fichier = Application.GetOpenFilename(FileFilter:="Fichiers Excel (*.xls*), *.xls*", Title:="Choix du fichier de comparaison", MultiSelect:=False)

Workbooks.Open (Fichier)
Range("A1") = WorksheetFunction.VLookup(Range("A5"), Workbooks(Fichier).Workrsheet("Série non configurable").Range("A12:32"), 14, False)

End Sub
 
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
Bonsoir,

Tes fichiers sont bizarres. Je pense que c'est l'une des raisons que tu n'aies pas eu de réponse.
Code à tester.
VB: 
Sub Transfert()
   Dim Ancien As Workbook, MonFichier As Workbook
   Dim Fichier As String
   Set MonFichier = ThisWorkbook

   'fermer tous les fichiers excel sauf le concerné
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False

   For Each Ancien In Application.Workbooks
      If Not (Ancien Is Application.ThisWorkbook) Then
         Ancien.Close
      End If
   Next

   'invite ouverture fichier
   Fichier = Application.GetOpenFilename(FileFilter:="Fichiers Excel (*.xls*), *.xls*", _
                                         Title:="Choix du fichier de comparaison", MultiSelect:=False)

   If Fichier = "Faux" Then
      Exit Sub
   Else
      Workbooks.Open (Fichier)

      var_nomfichier = Dir(Fichier)   'on recupere le nom du fichier à partir de son chemin complet
      'Split(Dir(Fichier), ".")(0)
      '
      With Workbooks(var_nomfichier)
         With .ActiveSheet
            dl = .Cells(Rows.Count, 1).End(xlUp).Row
            For i = 12 To dl
               .Cells(i, 1) = .Cells(i, 1).Value * 1
               .Cells(i, 1).Offset(0, 3).Value = .Cells(i, 1).Offset(0, 3) * 1   '.NumberFormat = "#,##0"
               x = Application.Match(.Cells(i, 1), MonFichier.Sheets("Série 6000 2019 C").Range("A1:A155"), 0)
               If IsError(x) Then
                  GoTo suite
               Else: Debug.Print i, .Cells(i, 1), x
                  MonFichier.Sheets("Série 6000 2019 C").Cells(x, 5).Value = .Cells(i, 14).Value
suite:
               End If
            Next i
         End With
         .Close
      End With
   End If
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True

   MsgBox "Traitement terminé"
End Sub
Les nombres de la colonne commandé sont des milliers? Le point est un séparateur de millier ou décimal?

Bonne soirée.
 
Vote positif 0 Vote négatif
L

lolo_excelbeginner

XLDnaute Nouveau
cathodique à dit:
Bonsoir,

Tes fichiers sont bizarres. Je pense que c'est l'une des raisons que tu n'aies pas eu de réponse.
Code à tester.
VB: 
Sub Transfert()
   Dim Ancien As Workbook, MonFichier As Workbook
   Dim Fichier As String
   Set MonFichier = ThisWorkbook

   'fermer tous les fichiers excel sauf le concerné
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False

   For Each Ancien In Application.Workbooks
      If Not (Ancien Is Application.ThisWorkbook) Then
         Ancien.Close
      End If
   Next

   'invite ouverture fichier
   Fichier = Application.GetOpenFilename(FileFilter:="Fichiers Excel (*.xls*), *.xls*", _
                                         Title:="Choix du fichier de comparaison", MultiSelect:=False)

   If Fichier = "Faux" Then
      Exit Sub
   Else
      Workbooks.Open (Fichier)

      var_nomfichier = Dir(Fichier)   'on recupere le nom du fichier à partir de son chemin complet
      'Split(Dir(Fichier), ".")(0)
      '
      With Workbooks(var_nomfichier)
         With .ActiveSheet
            dl = .Cells(Rows.Count, 1).End(xlUp).Row
            For i = 12 To dl
               .Cells(i, 1) = .Cells(i, 1).Value * 1
               .Cells(i, 1).Offset(0, 3).Value = .Cells(i, 1).Offset(0, 3) * 1   '.NumberFormat = "#,##0"
               x = Application.Match(.Cells(i, 1), MonFichier.Sheets("Série 6000 2019 C").Range("A1:A155"), 0)
               If IsError(x) Then
                  GoTo suite
               Else: Debug.Print i, .Cells(i, 1), x
                  MonFichier.Sheets("Série 6000 2019 C").Cells(x, 5).Value = .Cells(i, 14).Value
suite:
               End If
            Next i
         End With
         .Close
      End With
   End If
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True

   MsgBox "Traitement terminé"
End Sub
Les nombres de la colonne commandé sont des milliers? Le point est un séparateur de millier ou décimal?

Bonne soirée.
Cliquez pour agrandir...
Bonjour Cath !

Merci beaucoup de ta réponse !
Oui je suis désolé pour le format des fichiers... Ils ont une forme étrange...

Merci beaucoup pour ton code, il fonctionne très bien. En revanche, j'ai un problème, dans le "fichier à remplir", il y a en fait plusieurs feuilles et j'ai remarqué que le code ne fonctionnait pas avec plusieurs feuilles... J'ai une erreur à ce niveau là :
1675068034128.png



Ce code sera à appliquer seulement sur les feuilles : "Série 6000 2019 C" et "Série (B)2000 2019 B" , les autres feuilles ont un format différent.
Précision je téléchargerai un fichier pour la feuille "Série 6000 2019 C" et un autre pour la feuille "Série (B)2000 2019 B", donc la manière dont il s'exécute maintenant est parfait, pas besoin de remplir les 2 feuilles simultanément !

Voilà merci d'avance pour ton aide sur ce problème et merci beaucoup pour ton super code !

CDT

LOLO

PS : les nombres de la colonnes "commandé" sont bien des nombres décimaux (2.000=2)
 

Pièces jointes

  • Fichier_téléchargé.xls
    43.5 KB · Affichages: 2
  • Fichier à remplir.xlsm
    113.9 KB · Affichages: 3
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
lolo_excelbeginner à dit:
Merci beaucoup pour ton code, il fonctionne très bien.
Cliquez pour agrandir...
Tant mieux.
lolo_excelbeginner à dit:
En revanche, j'ai un problème, dans le "fichier à remplir", il y a en fait plusieurs feuilles et j'ai remarqué que le code ne fonctionnait pas avec plusieurs feuilles... J'ai une erreur à ce niveau là :
1675068034128.png
Cliquez pour agrandir...
il n'y a aucune image. Ensuite, j'ai répondu à ta demande initiale, tu as parlé d'une feuille pas de 2.
Merci de joindre le second fichier.
 
Vote positif 0 Vote négatif
L

lolo_excelbeginner

XLDnaute Nouveau
cathodique à dit:
Tant mieux.

il n'y a aucune image. Ensuite, j'ai répondu à ta demande initiale, tu as parlé d'une feuille pas de 2.
Merci de joindre le second fichier.
Cliquez pour agrandir...
Pardon, je n'avais pas vu que l'image ne s'est pas téléchargée...

1675076240916.png


Les fichiers sont ceux que je t'ai mis dans mon message précédent, j'ai rajouté les feuilles manquantes.

PS: le Transfert de données se fait bien, simplement, j'obtiens une erreur, et je ne vais pas jusqu'au message de fin..

Merci d'avance !

CDT LOLO
 

Pièces jointes

  • Fichier à remplir.xlsm
    113.9 KB · Affichages: 1
  • Fichier_téléchargé.xls
    43.5 KB · Affichages: 1
Vote positif 0 Vote négatif
L

lolo_excelbeginner

XLDnaute Nouveau
cathodique à dit:
Tant mieux.

il n'y a aucune image. Ensuite, j'ai répondu à ta demande initiale, tu as parlé d'une feuille pas de 2.
Merci de joindre le second fichier.
Cliquez pour agrandir...
Cath,

J'ai trouvé la cause de l'erreur, c'est que j'avais supprimé des données en fin de tableaux dans le "fichier à télécharger". Du coup en limitant l'indice à 65 cela fonctionne très bien merci !

Il faudrait juste que ce code puisse fonctionner sur les deux feuilles : "Série 6000 2019 C" et "Série (B)2000 2019 B". Et ça sera parfait !!

CDT

LOLO
 

Pièces jointes

  • Fichier_téléchargé.xls
    46 KB · Affichages: 8
  • Fichier à remplir.xlsm
    113.9 KB · Affichages: 7
Vote positif 0 Vote négatif
cathodique

cathodique

XLDnaute Barbatruc
Bonsoir,

à tester. Bonne soirée.
VB: 
Option Explicit
Sub Transfert()
   Dim Ancien As Workbook, MonFichier As Workbook, NomFichier As String, X As Variant
   Dim Fichier As String, Tf, i As Long, item, dl As Long, Plage As Range
   Set MonFichier = ThisWorkbook
  
Tf = Array("Série 6000 2019 C", "Série (B)2000 2019 B") 'feuilles concernées dans un array pour faire une boucle
 
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False

'fermer tous les fichiers excel sauf le concerné
   For Each Ancien In Application.Workbooks
      If Not (Ancien Is Application.ThisWorkbook) Then
         Ancien.Close
      End If
   Next
'-----------------------------------------------------------
   'invite ouverture fichier
   Fichier = Application.GetOpenFilename(FileFilter:="Fichiers Excel (*.xls*), *.xls*", _
                                         Title:="Choix du fichier de comparaison", MultiSelect:=False)
'-----------------------------------------------------------
   If Fichier = "Faux" Then Exit Sub
   Workbooks.Open (Fichier)

   NomFichier = Dir(Fichier)   'on recupere le nom du fichier à partir de son chemin complet
   With Workbooks(NomFichier)
      With .ActiveSheet
         dl = .Cells(Rows.Count, 1).End(xlUp).Row
         For i = 12 To dl
            .Cells(i, 1) = .Cells(i, 1).Value * 1
            .Cells(i, 1).Offset(0, 3).Value = .Cells(i, 1).Offset(0, 3) * 1

            For Each item In Tf
               Set Plage = MonFichier.Sheets(item).Range("A1:A" & MonFichier.Sheets(item).Cells(Rows.Count, 1).End(xlUp).Row)
               X = Application.Match(.Cells(i, 1), Plage, 0)
               If Not IsError(X) Then MonFichier.Sheets(item).Cells(X, 5).Value = .Cells(i, 14).Value
            Next item
         Next i
      End With
      .Close
   End With
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
   Set Plage = Nothing
   MsgBox "Traitement terminé"
End Sub
 
Vote positif 1 Vote négatif
Solution
L

lolo_excelbeginner

XLDnaute Nouveau
cathodique à dit:
Bonsoir,

à tester. Bonne soirée.
VB: 
Option Explicit
Sub Transfert()
   Dim Ancien As Workbook, MonFichier As Workbook, NomFichier As String, X As Variant
   Dim Fichier As String, Tf, i As Long, item, dl As Long, Plage As Range
   Set MonFichier = ThisWorkbook
 
Tf = Array("Série 6000 2019 C", "Série (B)2000 2019 B") 'feuilles concernées dans un array pour faire une boucle
 
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False

'fermer tous les fichiers excel sauf le concerné
   For Each Ancien In Application.Workbooks
      If Not (Ancien Is Application.ThisWorkbook) Then
         Ancien.Close
      End If
   Next
'-----------------------------------------------------------
   'invite ouverture fichier
   Fichier = Application.GetOpenFilename(FileFilter:="Fichiers Excel (*.xls*), *.xls*", _
                                         Title:="Choix du fichier de comparaison", MultiSelect:=False)
'-----------------------------------------------------------
   If Fichier = "Faux" Then Exit Sub
   Workbooks.Open (Fichier)

   NomFichier = Dir(Fichier)   'on recupere le nom du fichier à partir de son chemin complet
   With Workbooks(NomFichier)
      With .ActiveSheet
         dl = .Cells(Rows.Count, 1).End(xlUp).Row
         For i = 12 To dl
            .Cells(i, 1) = .Cells(i, 1).Value * 1
            .Cells(i, 1).Offset(0, 3).Value = .Cells(i, 1).Offset(0, 3) * 1

            For Each item In Tf
               Set Plage = MonFichier.Sheets(item).Range("A1:A" & MonFichier.Sheets(item).Cells(Rows.Count, 1).End(xlUp).Row)
               X = Application.Match(.Cells(i, 1), Plage, 0)
               If Not IsError(X) Then MonFichier.Sheets(item).Cells(X, 5).Value = .Cells(i, 14).Value
            Next item
         Next i
      End With
      .Close
   End With
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
   Set Plage = Nothing
   MsgBox "Traitement terminé"
End Sub
Cliquez pour agrandir...
Bonjour Cath!

C'est parfait merci beaucoup !!!!

Félicitation et merci!

LOLO
 
Vote positif 0 Vote négatif

Discussions similaires

P
  • Résolu(e)
XL 2021 Besoin d'aide pour copier/coller données de plusieurs classeurs
2
Réponses
20
Affichages
574
Pac41240
P
Magnio
  • Question
XL 2016 Transfert de données d'un tableau en différenciant les libellés
Réponses
8
Affichages
427
Magnio
Magnio
F
  • Question
XL 2016 Recherche multi classeurs
Réponses
5
Affichages
153
mromain
mromain
G
  • Question
XL 2021 Utilisation de données pour un autre fichier
Réponses
2
Affichages
242
job75
job75
R
  • Question
XL 2010 Copier des lignes de données de plusieurs feuilles dans une seule
Réponses
5
Affichages
275
sylvanu
sylvanu
kaine
  • Question
Microsoft 365 Importer données depuis un lien web
Réponses
1
Affichages
183
gbinforme
G
C
  • Question
XL 2021 Transfert d'une partie de tableau sur une autre page avec affichage différent
2
Réponses
16
Affichages
595
clausen
C
edgy63
  • Question
Microsoft 365 Remplir cellules à partir de plusieurs fichiers Excel d'un dossier
2
Réponses
17
Affichages
430
alexga78
A
MBax
  • Résolu(e)
Microsoft 365 Extraction d'informations sur différents onglets en partant d'une base de données
Réponses
7
Affichages
469
MBax
MBax
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
351
Chaton77
Chaton77

Membres actuellement en ligne

17 membres et 136 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 647
Messages
2 111 531
Membres
111 191
dernier inscrit
Assjmka