Discussion :

[flagpara]

Bonjour à tous!

J'ai un fichier contenant une liste de noms en colonne C et sur chaque ligne le nom est suivi de caractéristiques. Je veux créer une maccro qui pour chaque ligne va créer un nouveau classeur et entrer les caractéristiques dans ce classeur.
La partie "copie des données d'un classeur à un autre" j'ai trouvé beaucoup d'infos dessus alors je pourrai peut-être m'en sortir. Mon problème actuellement c'est que je n'arrive pas à créer ces classeurs nommés.

Mon code ressemble à ça:

Code "vb :

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
 
Sub creationCRApapier()
 
Dim NoLign1 As Integer
Dim NewBook As Workbook
 
 
For NoLign1 = 8 To 48
    If Cells(NoLign1, 3).Value <> 0 Then
      Set NewBook = Workbooks.Add 'creation
      NewBook.SaveAs "C:\chemin\cells(nolign1,3).value.xlsm"
    End If
Next
 
 
End Sub

Le problème c'est que évidemment cells(nolign1,3).value ne renvoie pas la valeur de la cellule ici, il essaie d'enregistrer un classeur qui s'appelle comme ça. J'ai essayé aussi d'écrire: NewBook.SaveAs "C:\chemin\"&cells(nolign1,3).value&".xlsm" mais sans succés

Je ne sais pas s'il est possible d'enregistrer plusieurs classeurs successifs en fonction de la valeur d'une cellule, mais c'est ce que j'essaie de faire

Merci d'avance!

[kiki29]

Salut, à tester

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
Option Explicit
 
Private Declare Function SHCreateDirectoryEx Lib "Shell32.dll" Alias "SHCreateDirectoryExA" _
                                             (ByVal hwnd As Long, _
                                              ByVal pszPath As String, _
                                              ByVal lngsec As Long) As Long
 
Private Function CreationDossier(sDossier) As Long
Dim Rep As Long
    Rep = SHCreateDirectoryEx(0&, sDossier, 0&)
End Function
 
Sub creationCRApapier()
Dim NoLign1 As Long, NewBook As Workbook
Dim sDossier As String, iCpt As Long
    iCpt = 0
    Application.StatusBar = ""
    sDossier = ThisWorkbook.Path & "\" & "Essais"
    CreationDossier sDossier
 
    Application.ScreenUpdating = False
    For NoLign1 = 8 To 48
        If Feuil1.Cells(NoLign1, 3).Value <> 0 Then
            Set NewBook = Workbooks.Add
            Application.DisplayAlerts = False
            With NewBook
                .SaveAs sDossier & "\" & Feuil1.Cells(NoLign1, 3).Text & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
                .Close
            End With
            iCpt = iCpt + 1
            Application.DisplayAlerts = True
            Set NewBook = Nothing
        End If
        Application.StatusBar = iCpt
    Next NoLign1
    Application.ScreenUpdating = True
End Sub

[Pierre Fauconnier]

Salut.

Tu dois recomposer la chaine du nom en concaténant tes portions de chaine.

Code :

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

NewBook.SaveAs "C:\chemin\" & cells(nolign1,3).value & ".xlsm"

[flagpara]

Bonjour,

comme je l'ai dit dans mon premier message, c'est la première chose que j'ai essayé mais sans succés, j'ai réessayé en copiant ton code au cas où, j'obtiens une erreur 1004.

Je vais essayer la solution de kiki29, il va juste me falloir un peu de temps pour la comprendre ^^'

[Pierre Fauconnier]

Si cela ne fonctionne pas, c'est que la valeur de la cellule (par exemple C8) ne contient pas une valeur qui, collée au reste, donne un nom de chemin valide, par exemple parce que c:\chemin\ n'est pas un chemin valide.

Peut-être dois-tu aussi récupérer le chemin du fichier au travers d'une variable, mais dans ton code, ça ne transparait pas de façon limpide.

Cela dit, tu aurais intérêt à sortir ton chemin de ton code et à le mettre dans une cellule, le hard-coding (Mettre une donnée en dur dans le code), ce n'est jamais la bonne solution.

[flagpara]

Effectivement Pierre Fauconnier le hard coding était sans doute ce qui posait problème, ça et le contenu des cellules.

Cela-dit la solution de kiki29, après une ou deux modifications, est parfaite! Merci beaucoup tu viens de m'enlever une belle épine du pied je n'en demandais pas tant

Bonne journée et merci pour votre aide!