Comment mettre la date du jour en vba sur les lignes des fichiers?

anthooooony

XLDnaute Occasionnel
Bonjour,

J'ai automatisé un moyen pour récupérer tous les fichiers excels qui se trouvent dans un dossier windows, ça marche bien, seulement pour un dossier, j'ai des stats qui sortent sans notion de date dans l'export.
Je n'ai que, pour les distinguer la date qui se trouve dans chaque fichier
"Suivi Top 50 - production 10 derniers jours (Avec commande) 15-01-2013.xls"
En faisant un right et 10 caractères il me prendra la date, mais jene sais pas comment le faire en masse, je souhaiterais le mettre en 4ème colonne.
Auriez vous une piste svp?

Merci d'avance
Anthooooony

Total 8285 71,35 15-01-2013
Factures de DITA 2094 81 15-01-2013
Factures de REX 942 92 15-01-2013
Factures de LA ROBI (588) 482 75 15-01-2013

Code:
Sub factaveccmd()
  sousRépertoire = "Suivi Top 50 - production 10 derniers jours  (Avec commande)"
  [A2].CurrentRegion.Offset(1, 0).Clear
  Set maitre = ActiveWorkbook
  Repertoire = ThisWorkbook.Path
  nf = Dir(Repertoire & "\" & sousRépertoire & "\*.xls") ' premier fichier
  Do While nf <> ""
    Workbooks.Open Filename:=Repertoire & "\" & sousRépertoire & "\" & nf
    n = [A1].CurrentRegion.Rows.Count - 1
    [A1].CurrentRegion.Offset(1, 0).Copy _
    maitre.Sheets(5).[A65000].End(xlUp).Offset(1, 0)
    ActiveWorkbook.Close False
    '-- nom onglet
   ' [A1].End(xlDown).End(xlToRight).Offset(-n + 1, 1).Resize(n, 1) = Left(nf, Len(nf) - 4)
    nf = Dir ' fichier suivant
  Loop
End Sub
 

Dranreb

XLDnaute Barbatruc
Re : Comment mettre la date du jour en vba sur les lignes des fichiers?

Bonjour.
Je propose cette écriture:
VB:
Sub FactAvecCmd()
Const SousRépertoire = "\Suivi Top 50 - production 10 derniers jours  (Avec commande)"
Dim Cible As Range, Source As Range, NF As String, N As Long, Z As String, LaDate As Date
Set Cible = ActiveWorkbook.Sheets(5).Rows(2)
Cible.Resize(65000).ClearContents
ChDrive ThisWorkbook.Path: ChDir ThisWorkbook.Path & SousRépertoire
NF = Dir("*.xls") ' premier fichier
Do While NF <> ""
    Workbooks.Open Filename:=NF
    Set Source = ActiveSheet.[A1].CurrentRegion: N = Source.Rows.Count - 1
    Set Source = Source.Offset(1).Resize(N)
    Source.Copy Destination:=Cible
    ActiveWorkbook.Close False
    Z = Right$(Split(NF, ".")(0), 10) ' JJ-MM-AAAA
    Cible.Resize(N).Columns(4).Value = DateSerial(Right$(Z, 4), Mid$(Z, 4, 2), Left$(Z, 2))
    Set Cible = Cible.Offset(N)
    NF = Dir ' fichier suivant
    Loop
End Sub
À tester

P.S. Attention, j'ai fait plusieurs ajustements du code depuis la première mouture. Je n'y toucherai plus à partir de … maintenant !

À +
 
Dernière édition:

anthooooony

XLDnaute Occasionnel
Re : Comment mettre la date du jour en vba sur les lignes des fichiers?

Bonjour Dranreb,

Merci beaucoup pour ce code.

Je viens de l'essayer j'ai un problème il s'arrete après Set Source = Source.Offset(1).Resize(N) au moment d'arriver sur Source.Copy Destination:=Cible ..

c'est bisarre tout avait l'air de fonction jusqu'à cette ligne, la reconnaissance de toutes les lignes, l'ouverture du premier fichier etc..

merci de ton aide en tout cas

anthooooony
 

Dranreb

XLDnaute Barbatruc
Re : Comment mettre la date du jour en vba sur les lignes des fichiers?

Mais, il s'arrête sur un message d'erreur ?
Ça pourrait s'expliquer s'il rencontre une feuille vide dans le classeur ouvert. De toute façon s'il y a plusieurs feuilles dans les classeurs source, il serait bon de préciser Worksheets(1) par exemple dans Set Source, au cas où l'utilisateur aurait fermé le fichier depuis une autre feuille active.
Dérouler en pas à pas, de toute façon, mettre des espions.
À +
 

Dranreb

XLDnaute Barbatruc
Re : Comment mettre la date du jour en vba sur les lignes des fichiers?

Mettez des espions sur N, Cible.Address et Source.Address
Attention j'avais une erreur sur Cible, j'avais oublié que c'était dans la 5ième feuille et non la feuille active.
À +
 

Discussions similaires

Statistiques des forums

Discussions
312 207
Messages
2 086 232
Membres
103 161
dernier inscrit
Rogombe bryan