[CLOS] Généra° auto de fichiers à partir d'un listing référence et copie d'infos

[goupette]

Bonjour à toutes et tous,

Après quelques recherches, je n'ai malheureusement pas trouvé ce dont j'avais besoin (ou bien je n'ai pas utilisé les bons termes dans ma recherche et m'en excuse )
De ce fait, je viens solliciter votre aide et vous remercie par avance du temps que vous voudriez bien prendre pour lire ma problématique et tenter d'y répondre.


Je travaille sur Excel 2010 mais souvent je prends l'option compatibilité en Excel 2007

Je dois à partir d'un fichier que je nommerai ici "Listing Tiers", :

1/ créer un fichier Excel pour chacun des Tiers listés dans ce fichier (dans le fichier joint, petite extraction car j'ai plus de 1800 tiers à traiter) à partir d'un modèle de fichier existant "une matrice" qui comporte 3 onglets. (Le 1er, je dois y apporter des informations et les 2 autres, je n'y touche pas, ils seront complétés par des tierces personnes)
Le fichier Excel qui doit être créé doit reprendre dans le libellé le numéro du tiers et suivi de "_512014"

2/ Sur le fichier obtenu et référencé comme indiqué précédemment, je dois donc y rapatrier des éléménts que l'on trouve sur le listing tiers. j'aimerai que cette étape soit également (si possible) automatisée.


Pour illustrer ma demande et je l'espère être plus claire .. et vous donnez le maximum d'informations) je vous joins trois fichiers .

Un extrait du listing tiers, ma matrice et un fichier tel que je souhaiterai l'obtenir en automatique ...

Je prends l'exemple du premier tiers :
Sur mon listing, il s'agit de 506020 - VILLE Myriam
Je souhaiterait qu'un nouveau fichier (basée sur ma matrice) lui soit dédié et soit nommé 506020_512014.xls
Et que sur ce fichier apparaissent, sur l'onglet "PlacesOccupees", les mêmes informations trouvées sur le listing à savoir plus précisement les colonnes "Numéro de dossier", "Numéro de décision" et "Date début"

J'ai mis en vert les colonnes à copier d'un fichier sur l'autre.

Pensez vous que cela soit envisageable ?
Vous remerciant pour vos réponses.
Bonne journée

goupette

 

[Staple1600]

Re : Généra° automatique de fichiers à partir d'un listing référence et copie d'infos

Bonjour à tous


Oui c'est envisageable
Voici un début de piste encore un chouia chancelant

Sub a()
Dim i&, NewWBK As Workbook
For i = 2 To ThisWorkbook.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row
    On Error Resume Next
    Windows("MATRICE.xls").Activate
    Sheets(Array("PlacesOccupees", "Sorties", "ListeAttente")).Copy
    Set NewWBK = ActiveWorkbook
        With ThisWorkbook.Sheets("Listing TIERS")
            .Cells(i, "E").Copy NewWBK.Sheets(1).Range("A2")
            .Cells(i, "F").Copy NewWBK.Sheets(1).Range("B2")
            .Cells(i, "G").Copy NewWBK.Sheets(1).Range("D2")
        End With
    NewWBK.SaveAs ThisWorkbook.Path & "\" & Split(ThisWorkbook.Sheets(1).Cells(i, "B").Range("A1"), "-")(0) & "_512014" & ".xls"
    NewWBK.Close True
Next
End Sub

Les cellules fusionnées en colonne B compliquent la tâche, d'où le côté chancelant du code dans son état actuel.

Néanmoins, je te laisse tester.

PS: Les deux classeurs doivent être ouverts, et le code VBA est à mettre dans ListingTiers.

 

[goupette]

Re : Généra° automatique de fichiers à partir d'un listing référence et copie d'infos

Bonjour à tous et Bonjour tout particulier pour Staple1600 et un GRAND MERCI !


C'est super ce que tu m'as proposé ...
je viens de tester c'est impeccable

Pour contourner le problème des lignes fusionnées :

Si je défusionne les lignes et que je laisse la cellule du dessous vide, pourrait on plus facilement traiter les informations et recopier celles-ci sur le même fichier créer pour ce tiers ? (il peut arriver que j'ai jusque 5 lignes pour le même tiers et les éléments doivent intégrés le même fichier)


Merci par avance de la réponse qui pourra m'être faite.

Bonne journée

Bonjour à tous


Oui c'est envisageable
Voici un début de piste encore un chouia chancelant

Sub a()
Dim i&, NewWBK As Workbook
For i = 2 To ThisWorkbook.Sheets(1).Cells(Rows.Count, "B").End(xlUp).Row
    On Error Resume Next
    Windows("MATRICE.xls").Activate
    Sheets(Array("PlacesOccupees", "Sorties", "ListeAttente")).Copy
    Set NewWBK = ActiveWorkbook
        With ThisWorkbook.Sheets("Listing TIERS")
            .Cells(i, "E").Copy NewWBK.Sheets(1).Range("A2")
            .Cells(i, "F").Copy NewWBK.Sheets(1).Range("B2")
            .Cells(i, "G").Copy NewWBK.Sheets(1).Range("D2")
        End With
    NewWBK.SaveAs ThisWorkbook.Path & "\" & Split(ThisWorkbook.Sheets(1).Cells(i, "B").Range("A1"), "-")(0) & "_512014" & ".xls"
    NewWBK.Close True
Next
End Sub

Les cellules fusionnées en colonne B compliquent la tâche, d'où le côté chancelant du code dans son état actuel.

Néanmoins, je te laisse tester.

PS: Les deux classeurs doivent être ouverts, et le code VBA est à mettre dans ListingTiers.

 

[Staple1600]

Re : Généra° automatique de fichiers à partir d'un listing référence et copie d'infos

Re

Si je défusionne les lignes et que je laisse la cellule du dessous vide, pourrait on plus facilement traiter les informations et recopier celles-ci sur le même fichier créer pour ce tiers ? (il peut arriver que j'ai jusque 5 lignes pour le même tiers et les éléments doivent intégrés le même fichier)

Plutôt que de laisser vide, on peut envisager de recopier le nom du tiers N fois, puis d'utiliser une autre façon de faire.

En attendant que je te propose cette autre façon (si je trouve le temps), je laisse la main à mes petits camarades de jeu pour prendre la suite et te proposer d'autres pistes et/ou solutions.

 

[goupette]

Re : Généra° automatique de fichiers à partir d'un listing référence et copie d'infos

merci beaucoup Staple1600

oui ou recopier le tiers et ensuite fusionner les fichiers aux noms identiques, que les données se compilent... c'est possible çà ? lol

ou je rêve ??

Re




Plutôt que de laisser vide, on peut envisager de recopier le nom du tiers N fois, puis d'utiliser une autre façon de faire.

En attendant que je te propose cette autre façon (si je trouve le temps), je laisse la main à mes petits camarades de jeu pour prendre la suite et te proposer d'autres pistes et/ou solutions.

 

[Staple1600]

Re : Généra° automatique de fichiers à partir d'un listing référence et copie d'infos

Re

Oui c'est possible.
Et je dois avoir cela dans mes archives mais pour le moment, entre la lessive à étendre, quelques achats de Noël à aller faire incessamment sous peu, il va falloir qu je lâche le clavier pour un petit moment.

Je repasse plus tard dans ton fil avec une proposition de code
(sauf si à mon retour, je vois que d'autres membres t'ont proposé une solution, je m’abstiendrai pour aussitôt enquiller sur la vaisselle, un peu de repassage, coup d'aspi, passage de toile et tutti quanti )

PS: J'espère pour toi qu'ils passeront dans ton fil
(et j'espère pour moi qu'ils ne passeront pas... pou éviter les corvées domestiques )

 

[goupette]

Re : Généra° automatique de fichiers à partir d'un listing référence et copie d'infos

mdr

Bon courage et sans doute à tout à l'heure
je t'aide (par mes pensées) pour les tâches ménagères (que je viens de terminer chez moi (quelle corvée )

Re

Oui c'est possible.
Et je dois avoir cela dans mes archives mais pour le moment, entre la lessive à étendre, quelques achats de Noël à aller faire incessamment sous peu, il va falloir qu je lâche le clavier pour un petit moment.

Je repasse plus tard dans ton fil avec une proposition de code
(sauf si à mon retour, je vois que d'autres membres t'ont proposé une solution, je m’abstiendrai pour aussitôt enquiller sur la vaisselle, un peu de repassage, coup d'aspi, passage de toile et tutti quanti )

PS: J'espère pour toi qu'ils passeront dans ton fil
(et j'espère pour moi qu'ils ne passeront pas... pou éviter les corvées domestiques )

 

[Modeste]

Re : Généra° automatique de fichiers à partir d'un listing référence et copie d'infos

Bonsoir Goupette et la fée du logis

[...] et j'espère pour moi qu'ils ne passeront pas... pour éviter les corvées domestiques

Pour rien au monde nous n'eussions souhaité vous priver, cher JM, de ce plaisir sans cesse renouvelé! Vaquez à vos tâches très cher et ne cherchez point prétexte à surseoir!
Vous vous empresserez ensuite de fournir une solution à Goupette, en cessant céans de vous faire attendre, que diantre!

... Tout ça pour deux malheureuses brouettes de repassage accumulé depuis six mois à peine!


PS: on veut des vidéos de l'homme en tablier, le torchon sous senestre et le fer dans la dextre!

 

[Staple1600]

Re : Généra° automatique de fichiers à partir d'un listing référence et copie d'infos

Re, Bonsoir Modeste

PS: on veut des vidéos de l'homme en tablier, le torchon sous senestre et le fer dans la dextre!

C'est bien parce que c'est toi , alors ci-dessous voici ton vœu exaucé.
Regarde la pièce jointe 931648

Pour le reste, je m'y colle tout doucement

PS: Mais Modeste, tu peux te joindre à la danse (et pas forcément avec des talons)
T'as bien une petit idée pour aider Goupette,non ?

 

[Staple1600]

Re : Généra° automatique de fichiers à partir d'un listing référence et copie d'infos

Re


En attendant que Modeste chaloupe en rythme dans son VBE, et pour continuer sur ma lancée
(et en me basant sur un code que j'ai récemment utilisé dans un autre fil)
Voici la trame de mon idée
Avec un macro de ce type, on Split la feuille des tiers en N feuilles
Ensuite si besoin on boucle sur cette nouvelles feuilles pour supprimer les colonnes non nécessaires
et au sein de cette boucle on copie la feuille en tant que nouveau classeur que l'on sauveagrd avec le nom désiré
puis on ferme le classeur ListingTiers sans enregistrer les modifs (ce qui détruira les feuilles temporaires)
Ce qui est en gras et bleu est le code VBA qui reste à créer.

Modeste, tu prends le relais pour la suite pendant que j'ai voir un peu de Miss France ?
(ou tout autre programme télévisuel qui éveillera mon intérêt )

Sub SplitData()
'EDITION version modifiée pour copier la ligne d'entête
'code initial d'Alex P. ->-> stackoverflow
   Dim DataMarkers(), Names As Range, name As Range, n As Long, i As Long

    Set Names = Range(Cells(2, "B"), Cells(Rows.Count, "B").End(xlUp))
    n = 0
    DeleteWorksheets

    For Each name In Names
        If name.Offset(1, 0) <> name Then
            ReDim Preserve DataMarkers(n)
            DataMarkers(n) = name.Row
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).name = name
            n = n + 1
        End If
    Next name
'
   For i = 0 To UBound(DataMarkers)
        If i = 0 Then
        Worksheets(1).Range("B1:H1").Copy Destination:=Worksheets(i + 2).Range("A1")
        Worksheets(1).Range("B2:H" & DataMarkers(i)).Copy Destination:=Worksheets(i + 2).Range("A2")
        Else
        Worksheets(1).Range("B1:H1").Copy Destination:=Worksheets(i + 2).Range("A1")
        Worksheets(1).Range("B" & (DataMarkers(i - 1) + 1) & ":H" & DataMarkers(i)).Copy Destination:=Worksheets(i + 2).Range("A2")
        End If
    Next i
End Sub


Sub DeleteWorksheets()
    Dim ws As Worksheet, activeShtIndex As Long, i As Long

    activeShtIndex = ActiveSheet.Index

    Application.DisplayAlerts = False
    For i = ThisWorkbook.Worksheets.Count To 1 Step -1
        If i <> activeShtIndex Then
            Worksheets(i).Delete
        End If
    Next i
    Application.DisplayAlerts = True
End Sub

 

[Staple1600]

Re : Généra° automatique de fichiers à partir d'un listing référence et copie d'infos

Bonjour à tous


Suite...
Goupette
Tu me dis si je suis toujours sur la bonne voie, stp ?
Pour tester, lancer la macro VasYMonRaoul
(code à mettre toujours dans Listing Tiers)

PS: On doit pouvoir faire plus synthétique mais pour cela goupette il faudrait attirer le chaland dans ton fil
J'espère que ce n'est pas la photographie postée qui le fait fuir, le chaland XLDien

Sub VasYMonRaoul()
'Tribute à Raoul Volfoni ;-)
JEdynamiteJEdisperseJEventile
Eparpillons_par_petits_boutsFaçonPuzzle
End Sub
Private Sub JEdynamiteJEdisperseJEventile()
'adapté de Splitdata : code initial d'Alex P. ->-> stackoverflow
   Dim DataMarkers(), Names As Range, name As Range, n As Long, i As Long

    Set Names = Range(Cells(2, "B"), Cells(Rows.Count, "B").End(xlUp))
    n = 0
    DeleteWorksheets
    For Each name In Names
        If name.Offset(1, 0) <> name Then
            ReDim Preserve DataMarkers(n)
            DataMarkers(n) = name.Row
            Worksheets.Add(After:=Worksheets(Worksheets.Count)).name = name
            n = n + 1
        End If
    Next name
'
   For i = 0 To UBound(DataMarkers)
        If i = 0 Then
        Worksheets(1).Range("B1:H1").Copy Destination:=Worksheets(i + 2).Range("A1")
        Worksheets(1).Range("B2:H" & DataMarkers(i)).Copy Destination:=Worksheets(i + 2).Range("A2")
        Else
        Worksheets(1).Range("B1:H1").Copy Destination:=Worksheets(i + 2).Range("A1")
        Worksheets(1).Range("B" & (DataMarkers(i - 1) + 1) & ":H" & DataMarkers(i)).Copy Destination:=Worksheets(i + 2).Range("A2")
        End If
    Next i
End Sub
Private Sub Eparpillons_par_petits_boutsFaçonPuzzle()
Dim sh As Worksheet, NOM_FIC$
For Each sh In ThisWorkbook.Worksheets
    If sh.name <> "Listing TIERS" Then
    NOM_FIC = VBA.Trim(Split(sh.name, "-")(0)) & "_512014"
    sh.Copy
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & NOM_FIC & ".xls"
    ActiveWorkbook.Close
    End If
Next sh
End Sub
Sub DeleteWorksheets()
    Dim ws As Worksheet, activeShtIndex As Long, i As Long
    activeShtIndex = ActiveSheet.Index
    Application.DisplayAlerts = False
    For i = ThisWorkbook.Worksheets.Count To 1 Step -1
        If i <> activeShtIndex Then
            Worksheets(i).Delete
        End If
    Next i
    Application.DisplayAlerts = True
End Sub

 

[Modeste]

Re : Généra° automatique de fichiers à partir d'un listing référence et copie d'infos

Bonjour le fil,

En attendant que Modeste chaloupe en rythme dans son VBE

Une voie d'eau, par tribord avant m'a maintenu à quai ... où j'ai fort bien dormi (bien qu'un cauchemar récurrent soit venu me hanter: un type, dans un immonde petit tablier en vichy rose, venait sans cesse me parler de Dim's )

Une approche à peine différente (toujours en attendant que Goupette valide!), ci-dessous.
C'est toujours bien plus simple quand on arrive après la bataille et que quelqu'un a déjà débroussaillé, borné le terrain et installé l'égouttage! ... En admettant que la présente proposition fasse bien la même chose que celle de l'ami JM (ce que je subodore, sans pouvoir l'affirmer avec certitude!?)

Sub uneAutre()
Set mat = Workbooks("MATRICE.xls")
Set sh = mat.Sheets("PlacesOccupees")
Application.ScreenUpdating = False
With Sheets("Listing TIERS")
    For lig = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
        cpt = IIf(.Cells(lig, 2).MergeCells, .Cells(lig, 2).MergeArea.Count, 1) 'compteur cellules fusionnées
        nomFic = Trim(Split(.Cells(lig, 2), "-")(0)) & "_512014"
        sh.[A2:B10].Clear 'maximum 5 lignes par tiers ... on efface les données collées au passage précédent dans la boucle
        .Cells(lig, 5).Resize(cpt, 2).Copy sh.[A2] 'on garnit les colonnes n° dossier et n° demande
        sh.[D2:D10].Clear
        .Cells(lig, 7).Resize(cpt, 1).Copy sh.[D2] 'on garnit la colonne Date
        mat.SaveCopyAs ThisWorkbook.Path & "\" & nomFic & ".xls"
        lig = lig - 1 + cpt
    Next lig
End With
Application.ScreenUpdating = False
mat.Close SaveChanges:=False
End Sub

@Staple1600: j'ai une erreur dans ton code au niveau du WorkSheets.Add quand on passe en ligne 4 ('name' est alors vide)

 

[Staple1600]

Re : Généra° automatique de fichiers à partir d'un listing référence et copie d'infos

Bonjour Modeste

Modeste
Très flatté d'avoir peuplé ta nuit, mais désolé que l'expérience ait heurté ton sens de l'esthétisme.
(Mais c'est toi qui ai voulu ma photo, alors assume )
Sinon je vois que tu as réalisé ce j'espérais

On doit pouvoir faire plus synthétique

@Staple1600: j'ai une erreur dans ton code au niveau du WorkSheets.Add quand on passe en ligne 4 ('name' est alors vide)

Pour l'erreur, c'est sans doute parce que j'ai défusionné les cellules en colonne B et recopier le nom des tiers dans les cellules ainsi libérées.
Mais cela n'a plus d'importance, car je t'adopte.
Euh, enfin , je veux dire que si j'étais Goupette, j’adopterai ton code VBA
car il est beau, concis, et qu'il sent bon le sable chaud.
PS: Au moins tout ceci m'aura donné envie de revoir les tontons et permis de saluer la mémoire de Raoul.

 

[Modeste]

Re : Généra° automatique de fichiers à partir d'un listing référence et copie d'infos

Re,

tout ceci m'aura donné envie de revoir les tontons

D'une soirée Miss France au charme ravageur de Bernard Blier, il n'y a qu'un pas (je ne sais pas trop dans quelle direction!?).
J'aurais, me semble-t-il, une légère préférence pour le monde façon Audiard, plutôt que de Fontenay (encore des cauchemars en perspective )

 

[goupette]

Re : Généra° automatique de fichiers à partir d'un listing référence et copie d'infos

Coucou à tous,
Bonsoir Modeste et Staple1600

Je viens de lire tous vos échanges, je suis repliée ! cela fait plaisir de voir que même si vous donnez beaucoup de votre personne pour aider les autres, vous savez le faire dans la bonne humeur et avec beaucoup d'humour !
Je vous "adopte" tous les deux lol...

Bon allez je file de ce clic.. tester tout ce que vous m'avez si gentiement mis en place

Merci beaucoup et à très vite