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

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
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...

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
 

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.
 

lolo_excelbeginner

XLDnaute Nouveau
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.
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

cathodique

XLDnaute Barbatruc
Merci beaucoup pour ton code, il fonctionne très bien.
Tant mieux.
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
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.
 

lolo_excelbeginner

XLDnaute Nouveau
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.
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

lolo_excelbeginner

XLDnaute Nouveau
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.
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

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
 

lolo_excelbeginner

XLDnaute Nouveau
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
Bonjour Cath!

C'est parfait merci beaucoup !!!!

Félicitation et merci!

LOLO
 

Discussions similaires

Réponses
7
Affichages
391

Statistiques des forums

Discussions
311 720
Messages
2 081 915
Membres
101 838
dernier inscrit
Christelle.B86