Discussion :

[Max-1989]

Bonjour,

très content de faire partie de ce forum et en espérant y trouver mes réponses

Voici ma problématique :

	A	B	C
1	OT	N° Affaire	Désignation
2	84079545	D21000	Ligne 1"
3	84079769	D21001	Ligne 2"
4	84083666	D21002	Ligne 3"

En me plaçant sur la ligne B2 ou B3 ou B4 etc,

je veux par l’intermédiaire d'une macro ==> Copier, Coller un dossier type et le renommer de la manière suivante.

* Dossier type ==> "N°Affaire - OT - SITE - DESIGNATION"
* Dossier copier ==> "N°Affaire = "Valeur en B" - "OT="Valeur en A" - "DJENO - "DESIGNATION="Valeur en C"
* Chemin du dossier type ==> "X:\Activités 2\043071 - CONTRAT DJENO\07 - SUIVI DES AFFAIRES\01-AFFAIRES"
* Chemin du dossier à créer (C'est le même)==> ="X:\Activités 2\043071 - CONTRAT DJENO\07 - SUIVI DES AFFAIRES\01-AFFAIRES"

Exemple si je me place en B2 et que je lance la macro cela doit donner dans mon serveur le dossier ==> " D21000 - 84079545 - DJENO - Ligne 1"

Attention: "DJENO" est un caractère en dur ainsi que les "-" entre chaque Mot

J'ai donc les opérations ci-dessous :

-Copier le dossier source, se trouvant dans le chemin d’accès ="X:\Activités 2\043071 - CONTRAT DJENO\07 - SUIVI DES AFFAIRES\01-AFFAIRES"
-Coller le dossier source dans le même chemin d'accès ="X:\Activités 2\043071 - CONTRAT DJENO\07 - SUIVI DES AFFAIRES\01-AFFAIRES"
- Renommer le dossier en fonction des valeurs dans les cellules
- Ne rien Faire si le dossier existe

En vous remerciant par avance pour l'aide précieuse que vous pouvez m'apporter

Max

[EricDgn]

Bonjour,

Pour autant que j'aie bien compris votre demande, quelque chose de ce genre devrait faire le travail:

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
Sub CopyAffaire()
    Dim sNomDoss As String, sNomFichType As String, sNomFich As String, kR As Long
    sNomDoss = "X:\Activités 2\043071 - CONTRAT DJENO\07 - SUIVI DES AFFAIRES\01-AFFAIRES"
    sNomFichType = "N°Affaire - OT - SITE - DESIGNATION.xlsx"
    kR = ActiveCell.Row
    sNomFich = Range("B" & kR) & " - " & Range("A" & kR) & " - DJENO - " & Range("C" & kR) & ".xlsx"
    If Dir(sNomDoss & "\" & sNomFich) = "" Then
        If MsgBox("Créer ce fichier ?  " & sNomFich, vbYesNo + vbDefaultButton2, "Oui-Non?") = vbYes Then
            FileCopy sNomDoss & "\" & sNomFichType, sNomDoss & "\" & sNomFich
        End If
    Else
        MsgBox "Le fichier " & sNomFich & vbCrLf & _
               "existe déjà dans le dossier" & vbCrLf & sNomDoss, , "Pour info"
    End If
End Sub

Cordialement.