XL 2016 Transfert de données d'un tableau en différenciant les libellés

Magnio · 16 Janvier 2024

Bonjour à tous,

Autodidacte et plutôt novice sur VBA sur certains thèmes, j'ai aujourd'hui un projet dont je n'arrive pas à trouver la solution et je m'en remet donc à vous.

C'est très simple, pour schématiser: il y a 3 fichiers : un fichier "Import" dans lequel on va puiser les données, un fichier Export dans lequel on va coller les données, et un fichier qui effectue le Transfert des données via VBA. Copier l'intégralité des données et les coller, ça je sais le faire et c'est la portion de code que je vous ai fourni dans le fichier.
Ce que je voudrais, c'est arriver à différencier les libellés de la colonne D et ne coller que ceux qui sont identiques dans un fichier Export et ce pour chaque libellé différent.

Pour essayer d'être plus clair, je vais prendre les exemples de mes fichiers fournis.
Il faudrait que les 21 lignes comportant le libellé "NEC 3 18-12-2023 PV 270297" soient copiées dans un fichier Export.
Puis que les 21 lignes comportant le libellé "NEC 1 20-12-2023 PV 270343" soient copiées à leur tour mais dans un autre fichier Export.
Et ainsi de suite pour autant de libellés que pourrait comporter la colonne.
Le top pour distinguer les différents fichier d'Export serait qu'ils portent le nom du libellé (assez logique).
J'ai réussi à faire un bout de code qui arrivait à "identifier" les différents libellés de ma colonne mais qui au final ne me copiait qu'une ligne de chaque libellé dans un seul et même fichier Export. J'ai supprimer cette partie du code qui ne servait à rien pour que ça soit le plus propre possible.

Pour que le projet fonctionne, il faut que les fichiers Import et Export soient sur le bureau (mais vous vous en seriez douté en lisant le code ^^).

D'avance merci pour toute l'aide que vous pourrez m'apporter et j'espère que ce que je demande n'est pas trop compliqué.

Dranreb · 16 Janvier 2024

Bonjour.
À tester :

VB:

Option Explicit
Sub Transfert()
   Dim WbkImp As Workbook, WshImp As Worksheet, TImp(), TTit(), Li As Long, Lib As String, _
      TExp(), Lx As Long, C As Integer, WbkExp As Workbook, WshExp As Worksheet
   Set WbkImp = Workbooks.Open("C:\Users\" & Environ("username") & "\Desktop\Import.xlsx")
   Set WshImp = WbkImp.Sheets("Résultats")
   TTit = WshImp.[A4].Resize(, 22).Value
   TImp = WshImp.[A5].Resize(WshImp.[A1000000].End(xlUp).Row - 4, 22).Value
   ReDim TExp(1 To UBound(TImp, 1), 1 To 22)
   Li = 1
   Do
      Lib = TImp(Li, 4)
      Do: Lx = Lx + 1
         For C = 1 To 22: TExp(Lx, C) = TImp(Li, C): Next C
         Li = Li + 1: If Li > UBound(TImp, 1) Then Exit Do
         Loop Until TImp(Li, 4) <> Lib
      Set WbkExp = Application.NewWorkbook
      Set WshExp = WbkExp.Worksheets(1)
      WshExp.[A4].Resize(, 22).Value = TTit
      WshExp.[A4].Resize(Lx, 22).Value = TExp
      WbkExp.SaveAs "C:\Users\" & Environ("username") & "\Desktop\" & Lib & ".xlsx"
      WbkExp.Close
      Loop Until Li > UBound(TImp, 1)
   WbkImp.Close Savechanges:=False
   End Sub

Magnio · 16 Janvier 2024

Bonjour et merci pour ta réponse rapide Dranreb. J'avais bien imaginé qu'il faudrait passer par une boucle, mais je ne voyais pas la méthode de cette façon pour générer les fichiers d'Export.
J'ai un message d'erreur pour un problème d'incompatibilité qui me renvoi à cette ligne:

Set WbkExp = Application.NewWorkbook

Dranreb · 16 Janvier 2024

Remplacez par Set WbkExp = Workbooks.Add

Magnio · 16 Janvier 2024

Cette modification fonctionne, mais...
-Les données copiées n'ont pas le format du fichier Export.
Ce qui se corrige en saisissant
Set WbkExp = Workbooks.Open("C:\Users\" & Environ("username") & "\Desktop\Export.xlsx")

J'ai également déclaré la cellule A5 comme première case à remplir.

-Cela ne fonctionne que pour le premier libellé. Les libellés suivant les données se cumulent avec les précédentes infos de la colonne.

Dranreb · 16 Janvier 2024

Ben remplacez peut être dans l'Open la partie Import par " & Lib & " comme dans le Wbk.SaveAs et remplacez celui ci par seulement Wbk.Save. Mais attention, il convient peut être de supprimer aussi d'anciennes lignes en trop.

Magnio · 16 Janvier 2024

Cette suggestion ne fonctionne pas. Le soucis n'est pas au niveau du fichier Export mais bien des données copiées et transposées.
J'ai modifié les données du fichier Import pour pouvoir expliquer avec des valeurs simples et sans ambiguïté.
Le fichier Import comporte 10 lignes dont le libellé est "Sujet 1", puis 20 lignes avec le libellé "Porte 2" et enfin 5 lignes avec le libellé "Tarte 3".
Si je lance la maccro, j'ai bien 3 fichiers exportés. Le premier s'appelle bien Sujet 1 et comporte 10 lignes. Le 2ème s'appelle Porte 2 mais comporte les 10 lignes Sujet 1 et les 20 lignes Porte 2. Enfin le 3ème s'appelle Tarte 3 et vous l'aurez compris il comporte les 10 lignes de Sujet 1, les 20 de Porte 2 et enfin les 5 lignes de Tarte 3.

Dranreb · 16 Janvier 2024

J'ai oublié une instruction derrière le premier Do : Lx = 0
Il faut en effet remettre à 0 le numéro de ligne export courant au début de chaque export.

Magnio · 17 Janvier 2024

Ça marche parfaitement! Encore un grand merci à toi!

Je regarde les petits fignolages à faire pour adapter ce code à mon vrai projet (c'était des fichiers test) et si tout est ok je clôturerai la discussion.

XL 2016 Transfert de données d'un tableau en différenciant les libellés

Magnio

XLDnaute Nouveau

Pièces jointes

Dranreb

XLDnaute Barbatruc

Magnio

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Magnio

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Magnio

XLDnaute Nouveau

Dranreb

XLDnaute Barbatruc

Magnio

XLDnaute Nouveau

Discussions similaires