Discussion :

[diabolo162]

Voila je vous sollicite car je bloque sur mon petit bout de code que je n'arrive pas à développer.

Ma macro copie et colle un dossier "Semaine" (avec tous ses sous dossiers et ses fichiers) et renomme le dossier en fonction du nom d'une cellule dans une feuille..(ex : Semaine 30).
Je souhaiterai à la suite ouvrir un fichier "Menu" du dossier créer pour importer des données mais JE N ARRIVE PAS A OUVRIR CE FICHIER AUTOMATIQUEMENT.

Pourriez vous me donner un petit coup de pouce? merci

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub CreerDossierAlternatif()
On Error Resume Next
    Dim Nom As String
    Dim Fso As Object, Source As String, Destination As String
    Nom = Feuil6.[g2]
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Source = "C:\Users\Alex\Desktop\SEMAINE"
    Destination = "C:\Users\Alex\Desktop\SEMAINE" & Nom
    Fso.CopyFolder Source, Destination, False
 
   Ps J'aimerai que le code ouvre le fichier "Menu" du dossier créer

[kiki29]

Salut, qqs utilité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
15
16
17
18
19
20
21
22
23
24
25
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
 
Private Function NomDossierValide(sChaine As String) As Boolean
Dim i As Long
Const CaracInterdits As String = """*/:<>?[\]|"
    NomDossierValide = True
    If Len(sChaine) = 0 Then
        NomDossierValide = False
        Exit Function
    End If
    For i = 1 To Len(CaracInterdits)
        If InStr(sChaine, Mid$(CaracInterdits, i, 1)) > 0 Then
            NomDossierValide = False
            Exit Function
        End If
    Next i
End Function

Code :

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

1
2
3
If FSO.Fileexists(......) Then
......
End If

Ne pas oublier le \ quand nécessaire.
Supprimer le On Error Resume Next totalement inutile.

Voir lire et assimiler : Manipulation des fichiers en VBA

[diabolo162]

Merci beaucoup pour ta réponse apportée malgré que je ne comprends strictement rien a son contenu.

Finalement j'ai une réponse adaptée sans modifier ma macro en la complétant par :

Code :

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

Set Fichier = Workbooks.Open(Destination & "\Menu.xls")

A la suite de ma macro, sur la Feuil ("Menu") la selection de la cellule ("B1") ne se réalise pas!!!
J'ai mis en Blue la partie du me code qui ne fonctionne pas...

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
 Private Sub CommandButton3_Click()

    On Error Resume Next
    Dim Nom As String
    Dim Fso As Object, Source As String, Destination As String
    Dim Fichier As Object
    Nom = Feuil6.[g2]
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Source = "C:\Users\Alex\Desktop\SEMAINE"
    Destination = "C:\Users\Alex\Desktop\" & Nom
    Fso.CopyFolder Source, Destination, True
    'ouverture fichier "Menu.?????"
   
    Set Fichier = Workbooks.Open(Destination & "\Menu.xls")

    Windows("Création Menu Eté.xls").Activate
    Sheets(6).Range("B1:C53").Copy
    Windows("Menu.xls").Activate
    Range("B1").Select
    ActiveSheet.Paste Link:=True

[diabolo162]

Avec "Range" Il faut selectionner une Plage et non une cellule

Code :

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

1
2
3
   Windows("Menu.xls").Activate
    Range("B1:C53").Select

[kiki29]

Salut, c'est bien dommage car cela t'éviterait, entre autres, bien des déboires et te permettrait de supprimer cet horrible On Error Resume Next totalement inutile.