[XL-2007] duplication automatique de fichiers excel [Résolu]

[florianne]

Bonjour à tous,

Je suis une utilisatrice d'excel mais je suis bien loin de maitriser l'utilisation des macros.Pourtant aujourd'hui elle me simplifierai bien la vie

Je cherche à dupliquer automatiquement, via une macro, un fichier excel. Il porterait comme nom, le nom de la personne et son prénom situés dans les 2 premières colonnes du deuxième onglet (Nom-Prenom.xlsm)

Pouvez vous m'aider ?

[kiki29]

Salut, à tester

Code :

1
2
3
4
5
6
7
8
Option Explicit
 
Sub Tst()
Dim sNom As String
 
    sNom = ThisWorkbook.Path & "\" & Feuil1.Range("A1") & "-" & Feuil1.Range("B1") & ".xlsb"
    ThisWorkbook.SaveCopyAs Filename:=sNom
End Sub

Il conviendra d'ajouter une vérification sur le caractère correct ou non du nom du fichier : pas de caractères interdits "*/:<>?[\]|

[florianne]

Merci beaucoup
j'ai testé mais ça ne fonctionnait pas.
Mais j'ai quand même réussi en apportant 2 modifications:

Code :

1
2
3
4
5
6
7
8
9
Option Explicit
 
Sub Tst()
Dim sNom As String
 
    sNom = ThisWorkbook.Path & "\" & Feuil2.Range("A1") & "-" & Feuil2.Range("B1") & ".xlsm"
    ThisWorkbook.SaveCopyAs Filename:=sNom
End Sub

parce que les noms et prénoms sont sur le second onglet et puis l'extension .xlsb ne passait pas.

Et la ça marche merci !!

C'est bien ce que je veux ,cependant le second onglet ne contient pas un mais prés de 400 noms et prénoms les uns à la suite des autres.
Comment faire ?
Vous comprenez là que la macro est très utile ^^ ça m'évite de créer 400 fichiers de suivi les un après les autres...

[kiki29]

Salut, ne versant pas dans la divination, en plus des caractères interdits il faudra penser aux doublons éventuels

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Explicit
 
Sub Tst()
Dim sNomFichier As String
Dim sNom As String
Dim i As Long, LastRow As Long
 
    LastRow = Feuil2.Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To LastRow
        sNomFichier = Feuil2.Range("A" & i) & "-" & Feuil2.Range("B" & i) & ".xlsm"
        sNom = ThisWorkbook.Path & "\" & sNomFichier
        ThisWorkbook.SaveCopyAs Filename:=sNom
    Next i
End Sub

Est-ce que seule Feuil1 devrait être sauvegardée ( sans Feuil2 ) ?

Un "détail" : Feuil2 est le CodeName et non le nom d'onglet de la feuille même si par défaut la dénomination est similaire
voir http://www.developpez.net/forums/d92...cel/vba-bases/

[florianne]

ça fonctionne

Pour ce qui est de la vérification des caractères, je vais la faire de visu car il ne devrait pas y avoir de problème.

Effectivement dans l'idéal il ne faudrait garder que le premier onglet.
Comment faire

On arrive au bout ^^
Merci

[kiki29]

Re,

Code :

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
Option Explicit
 
Sub Tst()
Dim sNomFichier As String
Dim sNom As String
Dim i As Long, LastRow As Long
    Application.ScreenUpdating = False
    LastRow = Feuil2.Range("A" & Rows.Count).End(xlUp).Row
    Feuil2.Columns("A:B").Interior.ColorIndex = xlNone
    Feuil1.Copy
    For i = 1 To LastRow
        sNomFichier = Feuil2.Range("A" & i) & "-" & Feuil2.Range("B" & i) & ".xlsm"
        sNom = ThisWorkbook.Path & "\" & sNomFichier
        If NomFichierValide(sNomFichier) Then
            If ExistenceFichier(sNom) = False Then
                ActiveWorkbook.SaveCopyAs Filename:=sNom
            Else
                '   Doublons sur Feuil2 en Jaune
                 Feuil2.Range("A" & i & ":B" & i).Interior.ColorIndex = 36
            End If
        Else
            '   Nom invalide en Orange
            Feuil2.Range("A" & i & ":B" & i).Interior.ColorIndex = 44
        End If
    Next i
    Application.DisplayAlerts = False
    ActiveWindow.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub
 
Private Function NomFichierValide(sChaine As String) As Boolean
Const CaracInterdits As String = """*/:<>?[\]|"
Dim i As Long
    NomFichierValide = True
    For i = 1 To Len(CaracInterdits)
        If InStr(sChaine, Mid$(CaracInterdits, i, 1)) > 0 Then
            NomFichierValide = False
            Exit Function
        End If
    Next i
End Function
 
Private Function ExistenceFichier(sFichier As String) As Boolean
    ExistenceFichier = Dir$(sFichier) <> ""
End Function

[florianne]

Milles mercis, !!!
ça fonctionne à merveille, en plus avec la recherche des mauvais caractères