Discussion :

[android59]

Bonjour,
je souhaiterais faire une macro pour créer un fichier excel, par ligne d'un fichier excel source, par exemple :

FichierSOurce:
nom prenom age
ligne 1 : Pierre Dupont 36 etc....
ligne 2: Croc Odile 42 ......

et donc quand je lancerais ma macro , il me créerait 2 fichiers un pour les données de la ligne 1 et l'autre pour celles de la ligne 2.

J'ai essayé cette macro mais il me dit que mes fichiers sont endommagés :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
Sub creer()
Dim cell As Range, FF&, Counter&
For Each cell In Range("A1:OJ1", Range("A" & Rows.Count).End(xlUp))
    If Len(cell) > 0 Then
        FF = FreeFile()
        Open ThisWorkbook.Path & "\" & Range("A" & cell.Row).Value & ".txt" For Output As #FF
        Print #FF, cell.Text
        Close #FF
        Counter = Counter + 1
    End If
Next cell
'MsgBox Counter & " fichiers créés. ", , "Fin de traitement"
End Sub

J'ai regardé plusieurs morceaux de codes mais rien y fait, pouvez vous m'aider svp ?

Merci beaucoup

[Franc]

Salut, j'ai testé ta macro et chez moi elle fonctionne sans provoquer d'erreur, les fichiers sont bien créés, donc le problème doit être ailleurs que dans la macro.

[android59]

j'ai restesté la macro et quand je laisse "txt", les fichiers sont vide, mais quand je me .xlsx, j'ai le message d'erreur suivant :


Les fichiers excels sont bien créés en fonction du nombre de ligne, mais impossible de les ouvrirs, sauriez vous svp m'indiquer une méthode pour avoir dans chaque fichier excel créé,les données se trouvant dans chaque ligne du fichier source?
merci

[android59]

J'ai utilisé un code qui a l'air pas mal, il me créé mes fichiers, mais dans chaque fichier, j'ai que l'entete, il doit y avoir quelque chose dans le code à fair emais j'ai du mal à trouver :

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
 
dossier = ThisWorkbook.Path & "\" '<<<adapter emplacement destination
Set dico = CreateObject("Scripting.dictionary")
 
Application.ScreenUpdating = False
With Sheets("Feuil1")
    dl = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = 2 To dl
        If Not dico.exists(.Cells(i, 1).Value2) Then
            dico(.Cells(i, 1).Value2) = ""
            chemin = dossier & .Cells(i, 1).Value2  '<<<chemin (ADAPTER NOM FICHIER) "UR " &
            .Parent.SaveCopyAs chemin
            Application.DisplayAlerts = False
            With Workbooks.Open(chemin)
                With .Sheets("Feuil1").UsedRange
                    .Cells.AutoFilter
                    .AutoFilter 1, "<>*" & .Cells(i, 1).Value2, xlFilterValues
                    .Offset(1, 0).Rows.Delete
                    .Cells.AutoFilter
                End With
                .SaveAs chemin & ".xlsx", 51
                .Close True
            End With
            Application.DisplayAlerts = True
        End If
    Next i
End With
Application.ScreenUpdating = True

[Franc]

Salut, vois si ça peut t'aider:

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
Sub creer()
 
    ' Déclarer les variables
    Dim classeurOrigine As Workbook ' Référence au classeur d'origine
    Dim dossier As String ' Le dossier de destination
    Dim dico As Object ' Le dictionnaire pour stocker les valeurs uniques
    Dim plages As Range ' Les plages de cellules non vides
    Dim cellule As Range ' La cellule courante
    Dim chemin As String ' Le chemin du fichier à enregistrer
 
    ' Conserver la référence au classeur d'origine
    Set classeurOrigine = ThisWorkbook
 
    dossier = classeurOrigine.Path & "\" ' <<< adapter emplacement destination
    Set dico = CreateObject("Scripting.dictionary")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    With classeurOrigine.Sheets(1)
        ' Sélectionner uniquement les cellules non vides de la colonne A
        Set plages = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp)).SpecialCells(xlCellTypeConstants)
        For Each cellule In plages
            If Not dico.exists(cellule.Value2) Then
                dico(cellule.Value2) = ""
                chemin = dossier & cellule.Value2 ' <<< chemin (ADAPTER NOM FICHIER) "UR "
 
                ' Créer un nouveau classeur
                Dim nouveauClasseur As Workbook
                Set nouveauClasseur = Workbooks.Add
 
                ' Copier les données de la colonne A du classeur d'origine dans le nouveau classeur
                classeurOrigine.Sheets(1).Range("A:A").Copy Destination:=nouveauClasseur.Sheets(1).Range("A1")
 
                With nouveauClasseur.Sheets(1)
                    ' Supprimer les lignes en double
                    .Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes
                End With
 
                ' Enregistrer le nouveau classeur sous un autre nom et format
                nouveauClasseur.SaveAs chemin, 51
                nouveauClasseur.Close SaveChanges:=True
            End If
        Next cellule
    End With
 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
 
    ' Revenir au classeur d'origine
    classeurOrigine.Activate
 
End Sub

[android59]

Bonjour,
merci beaucoup, c'est presque cela, avec ce code, j'ai mes fichiers en fonction des lignes du fichier source mais il ne me reprend que la colonne A.

j'ai joints des fichiers excel pour illustrer ce que je souhaiterais faire .
123456.xlsx

7896542.xlsx

fichier source.xlsx

Pour chaque ligne, je souhaiterais créer un fichier avec pour nom la valeur en colonne A, là c'est bon, mais je reprends le contenu de toutes la ligne,après peut importe si je n'ai pas l'entete dans le fichier .
j'ai tenté de modifier le code mais je n'y arrive pas

Merci beaucoup