Recuperer la date par le nom du classeur

Bonjour à tous,

J'ai besoin de votre aide s'il vous plait, j'ai besoin de récupérer le mois de la date du classeur à partir du nom du classeur et la coller sur une colonne, example "nom 01 2020", copier "01 2020" ,coller sur la colonne: Mois/année, et écrire au format : 01-2020 , sur toute la colonne .

Merci beaucoup d'avance

Salut maroua301,

  • précisions sur l'orthographe utilisée pour écrire ce nom de fichier ;
  • quelle colonne ? "Par exemple" ne suffit pas...

A+

salut curulis57,

merci pour votre réponse,

vous trouverez ci-joint, un fichier d'exemple .

merci d'avance .

Salut maroua301,

ainsi, entre autres possibilités, sûrement...

Private Sub Workbook_Open()
'
Dim tTab, sItem$
'
sItem = ThisWorkbook.Name
sItem = Left(sItem, InStrRev(sItem, ".") - 1)
tTab = Split(sItem, " ")
sItem = ""
If UBound(tTab) > 1 Then
    Range("B2").Value = DateSerial(CInt(tTab(UBound(tTab))), CInt(tTab(UBound(tTab) - 1)), 1)
    For x = 0 To UBound(tTab) - 2
        sItem = sItem & IIf(sItem = "", tTab(x), " " & tTab(x))
    Next
    Range("A2").Value = sItem
    Range("C2").Value = sItem & "-" & Format(Range("B2").Value, "mm/yyyy")
End If
'
End Sub

A+

merci pour ton aide, mais ta macro me met une erreur 1004, ça marcher une fois et après ça n'a pas marché, pour le nom du fichier j'aurais besoin de copier juste la date qui suis le nom du fichier exemple si le nom = "NAME 01 2019", je copie juste 01 2019, merci d'avance

Salut maroua301,

je viens de l'ouvrir 10 X d'affilée sans erreur et l'affichage correspond à 100% à ta demande.

Décris l'erreur affichée chez toi dans le détail, stp...

Quelle est la ligne de code surlignée de jaune ?

A+

j'ai un erreur sur cette ligne :

Range("B2").Value = DateSerial(CInt(tTab(UBound(tTab))), CInt(tTab(UBound(tTab) - 1)), 1)

Envoie le fichier avec lequel tu as une erreur... si ce n'est pas celui que je t'ai renvoyé, bien sûr!

A+

c'est bon ça marche, il fait une copie de la range A2 au collonne C3 + date du fichier, voici l'exemple, j'ai besoin de copier toute la colone A au colonne C, vous pouvez m'aider s'il vous plait.

Déso, je ne comprends rien à ce que tu veux faire...

Décris la procédure pas à pas avec un fichier qui illustre le résultat souhaité en fonction d'une situation de départ!

A+

j'ai fait des modification pour que la macro commence à copier les données de la colonne A2 + la deuxième partie du nom du fichier comme la colonne C3 en bleu, mais je veux prendre toute la colonne A comme mentionné en jaune et coller sur la collone C2:C

exemple

Salut maroua301,

de ce que j'ai compris...

Private Sub Workbook_Open()
'
Dim tTab, sItem$
'
sItem = ThisWorkbook.Name
sItem = Left(sItem, InStrRev(sItem, ".") - 1)
tTab = Split(sItem, " ")
sItem = ""
If UBound(tTab) > 1 Then
    Range("B2").Value = DateSerial(CInt(tTab(UBound(tTab))), CInt(tTab(UBound(tTab) - 1)), 1)
    For x = 0 To UBound(tTab) - 2
        sItem = sItem & IIf(sItem = "", tTab(x), " " & tTab(x))
    Next
    Range("D1").Value = sItem & "-" & Format(Range("B2").Value, "mm/yyyy")
    iRow = Range("A" & Rows.Count).End(xlUp).Row
    If iRow > 1 Then
        For x = 2 To iRow
            Range("B" & x).Value = Format(Range("B2").Value, "mm/yyyy")
            Range("C" & x).Value = Range("A" & x).Value & "-" & Format(Range("B2").Value, "mm/yyyy")
        Next
    End If
End If
'
End Sub

A+

je vous remercie pour votre retour, mais le fichier ne marche pas

Tu as téléchargé le fichier qui porte le même nom qu'un autre dans ton répertoire : il affiche certainement un nom comme...

UI234536 11 2020 (1)

Enregistre-le sous un nom de comportant pas cette excroissance...

A+

merci beaucoup maintenant ça marche, j'ai fait des modifications et ça marche .

Private Sub Workbook_Open()

'

Dim tTab, sItem$

'

sItem = ThisWorkbook.Name

sItem = Left(sItem, InStrRev(sItem, ".") - 1)

tTab = Split(sItem, " ")

sItem = ""

If UBound(tTab) > 1 Then

Range("B2").Value = DateSerial(CInt(tTab(UBound(tTab))), CInt(tTab(UBound(tTab) - 1)), 1)

For x = 0 To UBound(tTab) - 2

sItem = sItem & IIf(sItem = "", tTab(x), " " & tTab(x))

iRow = Range("A" & Rows.Count).End(xlUp).Row

Next

If iRow > 1 Then

For x = 2 To iRow

Range("B" & x).Value = Format(Range("B2").Value, "mm/yyyy")

Range("C" & x).Value = Range("A" & x).Value & "-" & Format(Range("B2").Value, "mm/yyyy")

Next

End If

End If

merci beaucoup

Bonjour curulis57,

est que vous pouvez m'aider pour terminer la macro que vous m'avez fait, pour effectuer une macro pour 3 fichier dans un dossier .

Sub Bouton1_Cliquer()

Dim i As Long

Dim wb As Workbook

Dim tTab, sItem

For i = 5 To 1

Set wb = Workbooks.Open("C:\Documents\Macro\dossier macro" & "\dossier" & i & ".xlsx")

Next

sItem = wb.Name

sItem = Left(sItem, InStrRev(sItem, ".") - 1)

tTab = Split(sItem, " ")

sItem = ""

If UBound(tTab) > 1 Then

Range("F2").Value = DateSerial(CInt(tTab(UBound(tTab))), CInt(tTab(UBound(tTab) - 1)), 1)

For x = 0 To UBound(tTab) - 2

sItem = sItem & IIf(sItem = "", tTab(x), " " & tTab(x))

iRow = Range("A" & Rows.Count).End(xlUp).Row

Next

If iRow > 1 Then

For x = 2 To iRow

Range("F" & x).Value = Format(Range("F2").Value, "mm/yyyy")

Range("G" & x).Value = Range("A" & x).Value & "-" & Format(Range("F2").Value, "mm/yyyy")

Next

End If

End If

End Sub

je vous remercie

Rechercher des sujets similaires à "recuperer date nom classeur"