Besoin d'aide

11snoozet-v4-1.xlsm (31.49 Ko)

bonjour a tous

j'ai un petit souci concernant une macro ppur generer des repertoires automatiquement

en fait je souhaiterait mettre des valeurs "date" dans la colonne A mais le prog me renvoi une erreur macro 76

merci de m'indiquer ce que je peut modifier pour que je puisse mettre des valeurs'date" (style 10-janv-2015) dans la colonne A

merci de votre aide

fichier en piece jointe

MERCI

Bonjour,

Sans avoir vu le fichier, ça va être difficile.

Option Explicit

Sub créer()

Dim x, i&, a&, verif$, n&, cpt&, t$ 'déclaration des variables dont on a besoin dans la macro

t = Timer

Feuil2.Cells.Clear 'là je vide l'intégralité de la feuille Feuil2

Feuil2.Cells(1, 1) = "Dossiers Générés" 'là je nomme la cellule de la feuille feuil2 A1 Dossiers générés

With Feuil1 'là je dis avec la feuille feuil1 pour éviter de réécrire dans toutes les lignes en dessous feuil1.etc etc

For i = 6 To Feuil1.Range("R" & Rows.Count).End(xlUp).Row 'définition des cellules à traiter de la ligne 6 à la dernière ligne remplie

'donc de ta colonne R en partant de R dernière ligne et en remontant

x = Split(.Cells(i, 18), "\") 'là je décompose la cellule pour tester la validité des dossiers donc en mettant x=split(.Cells(i,18)

'je décompose dans un tableau virtuel toutes les parties du nom contenu dans la cellule colonne 18 ligne i.

For a = 0 To UBound(x) 'là je vais maintenant tester si les dossiers existent bien déjà pour le chemin contenu dans cette cellule

If verif = "" Then verif = x(a) 'là il faut bien commencer par une valeur alors je dsi si la valeur de ma variable verif= rien alors je lui

'donne la veleur de mon tableau x(a) donc la valeur de x(0) puisque a sera égal de 0 à la fin du tableau x ubound signifiant la fin du tableau

If Dir(verif, vbDirectory) <> "" Then ' là je commence à vérifier et je dis si la direction de vérif est différent de "" donc rien

'donc encore si il existe, Alors si le dossier donc existe je vais au point 3 si il n'exisyte pas je vais au point 33

'MsgBox "Le dossier " & verif & " Existe déjà", , "Le fichier existe déjà!"

verif = verif & "\" & x(a + 1) '3) là je redonne une nouvelle valeur à verif en ajoutant le deuxième élément de mon tableau x

'donc en gros si le premier test était verif= C:\ là je rajoute un antislasch "\" et la valeur de x(a+1) donc x(0+1)

Else

MkDir (verif) '33) là je craie le dossier avec la valeur verif

Feuil2.Range("A" & Feuil2.Range("A" & Rows.Count).End(xlUp).Row + 1) = verif: cpt = cpt + 1 'là je recopie le nom du dossier

'généré à la dernière ligne vide de la colonne A de la feuille2

verif = verif & "\" & x(a + 1) 'là je donne à ma variable verif la nouvelle valeur que je dois vérifier

End If

If a = UBound(x) - 1 Then GoTo 1 'là je contrôle la valeur de ma variable a car comme j'ajoute des valeurs en point 3 et après le point 33

'maboucle doit donc s'arrêter à la fin de mon tableau x -1

Next a 'là c'est fini pour ma première vérification donc je continue ma boucle avec la prochaine valeur de a

1 verif = "" ' là avant de commencer une prochaine cellule R je remet la valeur de verif à vide

Next i

'voilà déjà pour la vérification des adresses et la création si inexistant des dossiers

'déjà essaye de cpomprendre un peu le dessus et tu me rediras quoi à Plus Papou

For i = 6 To Feuil1.Range("A" & Rows.Count).End(xlUp).Row

verif = .Cells(i, 18)

If Dir(verif & .Cells(i, 1), vbDirectory) = "" Then

MkDir (verif & .Cells(i, 1))

Feuil2.Range("A" & Feuil2.Range("A" & Rows.Count).End(xlUp).Row + 1) = verif & .Cells(i, 1): cpt = cpt + 1

Else

'MsgBox "Le dossier " & verif & .Cells(i, 1)& " Existe déjà", , "Le fichier existe déjà!"

End If

Next i

For i = 6 To Feuil1.Range("A" & Rows.Count).End(xlUp).Row

For a = 20 To 22

If Dir(verif & .Cells(i, 1) & "\" & .Cells(i, a), vbDirectory) = "" Then

MkDir (verif & .Cells(i, 1) & "\" & .Cells(i, a))

Feuil2.Range("A" & Feuil2.Range("A" & Rows.Count).End(xlUp).Row + 1) = verif & .Cells(i, 1) & "\" & .Cells(i, a)

cpt = cpt + 1

Else

'MsgBox "Le dossier " & verif & .Cells(i, 1) & "\" & .Cells(i, a) & " Existe déjà", , "Le fichier existe déjà!"

End If

Next a

Next i

For i = 6 To Feuil1.Range("A" & Rows.Count).End(xlUp).Row

verif = .Cells(i, 18) & .Cells(i, 1) & "\"

For a = 20 To 22

For n = 24 To 26

If Dir(verif & .Cells(i, a) & "\" & .Cells(i, n), vbDirectory) = "" Then

MkDir (verif & .Cells(i, a) & "\" & .Cells(i, n))

Feuil2.Range("A" & Feuil2.Range("A" & Rows.Count).End(xlUp).Row + 1) = verif & .Cells(i, a) & "\" & .Cells(i, n)

cpt = cpt + 1

Else

'MsgBox "Le dossier " & verif & .Cells(i, a) & "\" & .Cells(i, n) & " Existe déjà", , "Le fichier existe déjà!"

End If

Next n

Next a

Next i

End With

Feuil2.Select

Feuil2.Range("A" & Feuil2.Range("A" & Rows.Count).End(xlUp).Row + 1) = "Vous avez Généré " & cpt & " Dossiers"

MsgBox "Voilà c'est fait" & vbCrLf & _

"Vous avez Généré " & cpt & " Dossiers en " & Format(Timer - t, "0.00 s"), , "Création Terminée"

End Sub

Pour que ce soit plus lisible utilise les balise code

Sub créer()
Dim x, i&, a&, verif$, n&, cpt&, t$ 'déclaration des variables dont on a besoin dans la macro
t = Timer 

Et c'est plus facile avec un fichier d'exemple

Isa le fichier est joint dans le premier log ...

Cordialement

voici le code pour que ce soit plus pratique..tous fonctionne sauf si je met une date dans la colonne A la macro me renvoi une erreur pourquoi??

merci de votre aide

Option Explicit

Sub créer()
Dim x, i&, a&, verif$, n&, cpt&, t$ 'déclaration des variables dont on a besoin dans la macro
t = Timer
Feuil2.Cells.Clear 'là je vide l'intégralité de la feuille Feuil2
Feuil2.Cells(1, 1) = "Dossiers Générés" 'là je nomme la cellule de la feuille feuil2 A1 Dossiers générés
With Feuil1 'là je dis avec la feuille feuil1 pour éviter de réécrire dans toutes les lignes en dessous feuil1.etc etc
For i = 6 To Feuil1.Range("R" & Rows.Count).End(xlUp).Row 'définition des cellules à traiter de la ligne 6 à la dernière ligne remplie
'donc de ta colonne R en partant de R dernière ligne et en remontant
x = Split(.Cells(i, 18), "\") 'là je décompose la cellule pour tester la validité des dossiers donc en mettant x=split(.Cells(i,18)
'je décompose dans un tableau virtuel toutes les parties du nom contenu dans la cellule colonne 18 ligne i.
For a = 0 To UBound(x) 'là je vais maintenant tester si les dossiers existent bien déjà pour le chemin contenu dans cette cellule
If verif = "" Then verif = x(a) 'là il faut bien commencer par une valeur alors je dsi si la valeur de ma variable verif= rien alors je lui
'donne la veleur de mon tableau x(a) donc la valeur de x(0) puisque a sera égal de 0 à la fin du tableau x ubound signifiant la fin du tableau
If Dir(verif, vbDirectory) <> "" Then ' là je commence à vérifier et je dis si la direction de vérif est différent de "" donc rien
'donc encore si il existe, Alors si le dossier donc existe je vais au point 3 si il n'exisyte pas je vais au point 33
'MsgBox "Le dossier " & verif & " Existe déjà", , "Le fichier existe déjà!"
verif = verif & "\" & x(a + 1) '3) là je redonne une nouvelle valeur à verif en ajoutant le deuxième élément de mon tableau x
'donc en gros si le premier test était verif= C:\ là je rajoute un antislasch "\" et la valeur de x(a+1) donc x(0+1)
Else
MkDir (verif) '33) là je craie le dossier avec la valeur verif
Feuil2.Range("A" & Feuil2.Range("A" & Rows.Count).End(xlUp).Row + 1) = verif: cpt = cpt + 1 'là je recopie le nom du dossier
'généré à la dernière ligne vide de la colonne A de la feuille2
verif = verif & "\" & x(a + 1) 'là je donne à ma variable verif la nouvelle valeur que je dois vérifier
End If
If a = UBound(x) - 1 Then GoTo 1 'là je contrôle la valeur de ma variable a car comme j'ajoute des valeurs en point 3 et après le point 33
'maboucle doit donc s'arrêter à la fin de mon tableau x -1
Next a 'là c'est fini pour ma première vérification donc je continue ma boucle avec la prochaine valeur de a
1 verif = "" ' là avant de commencer une prochaine cellule R je remet la valeur de verif à vide
Next i
'voilà déjà pour la vérification des adresses et la création si inexistant des dossiers
'déjà essaye de cpomprendre un peu le dessus et tu me rediras quoi à Plus Papou
For i = 6 To Feuil1.Range("A" & Rows.Count).End(xlUp).Row
verif = .Cells(i, 18)
If Dir(verif & .Cells(i, 1), vbDirectory) = "" Then
MkDir (verif & .Cells(i, 1))
Feuil2.Range("A" & Feuil2.Range("A" & Rows.Count).End(xlUp).Row + 1) = verif & .Cells(i, 1): cpt = cpt + 1
Else
'MsgBox "Le dossier " & verif & .Cells(i, 1)& " Existe déjà", , "Le fichier existe déjà!"
End If
Next i
For i = 6 To Feuil1.Range("A" & Rows.Count).End(xlUp).Row
For a = 20 To 22
If Dir(verif & .Cells(i, 1) & "\" & .Cells(i, a), vbDirectory) = "" Then
MkDir (verif & .Cells(i, 1) & "\" & .Cells(i, a))
Feuil2.Range("A" & Feuil2.Range("A" & Rows.Count).End(xlUp).Row + 1) = verif & .Cells(i, 1) & "\" & .Cells(i, a)
cpt = cpt + 1
Else
'MsgBox "Le dossier " & verif & .Cells(i, 1) & "\" & .Cells(i, a) & " Existe déjà", , "Le fichier existe déjà!"
End If
Next a
Next i
For i = 6 To Feuil1.Range("A" & Rows.Count).End(xlUp).Row
verif = .Cells(i, 18) & .Cells(i, 1) & "\"
For a = 20 To 22
For n = 24 To 26
If Dir(verif & .Cells(i, a) & "\" & .Cells(i, n), vbDirectory) = "" Then
MkDir (verif & .Cells(i, a) & "\" & .Cells(i, n))
Feuil2.Range("A" & Feuil2.Range("A" & Rows.Count).End(xlUp).Row + 1) = verif & .Cells(i, a) & "\" & .Cells(i, n)
cpt = cpt + 1
Else
'MsgBox "Le dossier " & verif & .Cells(i, a) & "\" & .Cells(i, n) & " Existe déjà", , "Le fichier existe déjà!"
End If
Next n
Next a
Next i
End With
Feuil2.Select
Feuil2.Range("A" & Feuil2.Range("A" & Rows.Count).End(xlUp).Row + 1) = "Vous avez Généré " & cpt & " Dossiers"
MsgBox "Voilà c'est fait" & vbCrLf & _
"Vous avez Généré " & cpt & " Dossiers en " & Format(Timer - t, "0.00 s"), , "Création Terminée"
End Sub
Rechercher des sujets similaires à "besoin aide"