Discussion :

[Astumap]

Bonjour,

Je vous explique le problème.
J'ai un fichier sur lequel il y a une liste de contacts. On a une colonne avec leur nom et prénom, une avec des infos et une avec le chemin d'accès (récupéré par macro) qui mène au dossier serveur.
Chaque contact peut avoir plusieurs infos, donc un même contact peut s'étaler sur 10 lignes par exemple.

Ce que je souhaite arriver à faire, c'est créer un petit fichier excel pour chaque contact, en récupérant ses infos et enregistrer celui-ci dans le chemin du dossier du contact.

J'ai trié la liste par nom et prénom. Dans la colonne chemin répertoire, j'ai fait une formule pour que le chemin s'affiche sur la première ligne du contact, que sur les lignes suivantes ce soit vide et que sur la dernière ligne du contact concerné, il soit écrit "stop".

Il faudrait que la macro découpe cette liste après chaque "stop", pour créer le petit fichier excel et l'enregistrer. Seulement là je suis bien au-delà de mes compétences et c'est pour cela que je fais appel à vous. J'ai déjà du code pour créer un nouveau fichier excel, mais ce qui me bloque c'est surtout le découpage...

Merci d'avance !

[Kimy_Ire]

Fichier exemple ?

[Astumap]

Du fait de la confidentialité des données, je ne peux mettre le fichier en ligne (et de plus il est très volumineux).
Je vous ai donc crée un bref exemple bidon, pour aperçu.

[Kimy_Ire]

Dans "Fichier exemple" il y a le mot exemple !

Bref, ce que tu veux c'est exporter les données que tu as donné dans un fichier excel pour chaque nom et prénom ? C'est à dire faire du copier coller de toutes tes lignes qui ont le même nom et prénom et créer des fichiers excel correspondant à ces noms et prénoms ?

Veux-tu créer un fichier unique dans lequel tu placerais tes données en lignes pour chaque nom et prénom ?

Bref, exprime de manière plus précise ce que tu souhaites car je n'ai pas bien compris... personnellement...

PS : quand je parlais d'un fichier exemple c'est sur l'onglet 1 ce que tu donnes (c'est à dire le fichier "origine") et dans un second onglet, ce que tu souhaites obtenir.

**************************************************************
Autre chose : je n'ai pas bien compris le mécanisme que tu voulais utiliser avec tes "stop". Tu peux directement en colonne D écrire sur toutes les lignes quelque chose comme cela "=SI(A12<>A13; "stop"; "")" (ici en ligne 12 par exemple).
Pourquoi réécrire le chemin ? Est-ce utile dans ton fichier d'origine ?

[Astumap]

C'est pas faux

Voilà j'ai mis en PJ le fichier complété avec un deuxième onglet pour ce que je voudrais avoir.

Ce que j'imagine, c'est une macro avec boucle qui, à partir de la feuille "contacts_archiv", repérerait chaque contact (peu importe le nombre de lignes, tant que c'est le même contact) et qu'elle copie/colle les données du contact (comme présentées sur l'onglet "resultat") pour un nouveau fichier excel, qui irait s'enregistrer dans le répertoire du contact concerné (grâce au chemin fourni dans la première feuille).

Je crois que le mot "complexe" est approprié !

Et ici l'exemple de code que j'avais trouvé sur internet pour créer un fichier excel et l'enregistrer dans un répertoire donné :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub FichierExcel()
Dim XL As Object, WK As Object
Set XL = CreateObject("Excel.Application")
Set WK = XL.Workbooks.Add(&HFFFFEFB9)
With WK
With .Worksheets(1&)
.[A1] = 3&
.[A1:A10].DataSeries , , , 2&
.[B1] = 2&
.[B1:B10].DataSeries , , , 3&
.[D5].Formula = "=SUMPRODUCT((A1:A10>10)*(B1:B10<20))"
End With
.SaveAs CurDir & XL.PathSeparator & "MonFichierCreer.xls"
.Close
End With
XL.Quit
Set WK = Nothing
Set XL = Nothing
End Sub

Après j'avais pensé remplacer CurDir par une variable.
Exemple :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Chemin = Sheets("contacts_archiv").Range("D" & Suite).Value

Avec Suite qui tournerait dans la boucle Suite = Suite + 1 pour aller chercher les autres chemins.
Mais honnêtement je suis paumé, faudrait déjà arriver à caler ce que j'appellais plus haut le découpage. Pas évident tout ça...

Je pars en congés là pour la semaine de Noël, je reviens donc le 31 pour reprendre ce topic et essayer de trouver une solution avec ceux qui voudront bien m'aider !

Merci et bonnes fêtes !

[Kimy_Ire]

Voila le code que je te propose :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Sub save()
Dim test As Range
Dim cell_des As Range
Dim table() As String
Dim j As Integer
 
With Worksheets("contacts_archiv")
    Set test = .Range("A1")
    For i = 1 To .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row - 1
        ReDim table(1 To 1)
        If test.Offset(i, 0) <> test.Offset(i - 1, 0) Then
            j = 0
            Do
                ReDim Preserve table(1 To j + 1)
                table(j + 1) = test.Offset(i + j, 1).Value
                j = j + 1
            Loop Until test.Offset(i + j, 0).Value <> test.Offset(i, 0).Value
            AddNewWorkbook test.Offset(i, 0), table
        End If
    Next i
 
End With
 
End Sub
 
 
Function AddNewWorkbook(rng As Range, table() As String)
Dim xlApp As Excel.Application
Dim workb As Workbook
Dim xlSheet As Excel.Worksheet
 
Dim strt As Integer
Dim cell_des As Range
Dim msg As String
 
Set xlApp = CreateObject("Excel.Application")
xlApp.SheetsInNewWorkbook = 1
Set workb = Application.Workbooks.Add
workb.SaveAs Filename:=rng.Offset(0, 2).Value
xlApp.Visible = True
Set xlSheet = workb.Worksheets(1)
xlSheet.name = rng.Value
 
 
With ActiveWorkbook.Worksheets(rng.Value)
    Set cell_des = .Range("A1")
    cell_des = "Contact"
    cell_des.Font.Bold = True
    cell_des.Offset(0, 1) = "Infos"
    cell_des.Offset(0, 1).Font.Bold = True
    For i = 1 To UBound(table)
        cell_des.Offset(i, 0) = rng.Value
        cell_des.Offset(i, 1) = table(i)
    Next i
End With
 
ActiveWorkbook.Close SaveChanges:=True
 
xlApp.Quit
 
End Function

Dis moi si ça te convient et s'il fonctionne correctement. Chez moi, c'est bon !
Il n'est pas très optimisé mais fonctionne. J'espère que la macro ne prendra pas trop de temps.