Chargement de fichiers

Bonjour le forum

Je n'y connais pas grand chose mais j'ai un soucis pour le versement des données.

En fait j'ai 4 fichiers qui actuellement sont remplacés si plus récents mais en fait je veux les télécharger systématiquement.

J'aurais besoin d'aide pour supprimer ce système de récent.

Merci à vous.

Option Explicit

Private VersementOK As Boolean

Public Sub Worksheet_Activate()

Dim Chemin As String, RngFic As Range, TFic(), C As Long, NomFic As String, DatFic As Date, _

NbRécents As Long, Rép As VbMsgBoxResult, WbkDon As Workbook

Chemin = Me.[CheminDonnées].Value

Set RngFic = Me.[TabFichiers]

TFic = RngFic.Value

For C = 2 To 5

NomFic = Dir(Chemin & RngFic(1, C).Value)

TFic(6, C) = Empty: TFic(5, C) = "(• Non trouvé •)"

While NomFic <> ""

DatFic = FileDateTime(Chemin & NomFic)

If TFic(6, C) < DatFic Then

TFic(6, C) = DatFic: TFic(5, C) = NomFic

End If

NomFic = Dir: Wend

If TFic(3, C) < TFic(6, C) Then NbRécents = NbRécents + 1

Next C

If NbRécents Then Rép = MsgBox(IIf(NbRécents > 1, NbRécents & " fichiers plus récents ont été trouvés." & vbLf _

& "Voulez vous les ", "Un fichier plus récent a été trouvé." & vbLf & "Voulez vous l'") & "importer ?", _

vbYesNo, "Vérification dates fichiers") Else Rép = vbNo

If Rép = vbYes Then

For C = 2 To 5

If TFic(3, C) < TFic(6, C) Then

Set WbkDon = Workbooks.Open(Chemin & TFic(5, C))

Select Case C

Case 2: VerserDonnées WshRuptur, WbkDon

Case 3: VerserDonnées WshExtRea, WbkDon

Case 4: VerserDonnées WshRécept, WbkDon

Case 5: VerserDonnées WshCdeCX3, WbkDon

End Select

WbkDon.Close SaveChanges:=False

If VersementOK Then

TFic(2, C) = TFic(5, C)

TFic(3, C) = TFic(6, C)

TFic(4, C) = Now

End If

End If

Next C

End If

RngFic.Value = TFic

End Sub

Sub VerserDonnées(ByVal WshCible As Worksheet, ByVal WbkSource As Workbook)

Dim RngSource As Range

VersementOK = False

Set RngSource = WbkSource.Worksheets(1).UsedRange

Application.Goto RngSource

'If MsgBox("Actuellement sélectionné :" & vbLf & """" & RngSource.Address(False, False, xlA1, True) & """." _

' & vbLf & "Ce contenu sélectionné doit-il remplacer celui de la feuille :" _

'& vbLf & """[" & ThisWorkbook.Name & "]" & WshCible.Name & """ ?", _

' vbYesNo, "VerserDonnées") = vbNo Then Exit Sub

WshCible.Cells.ClearContents

RngSource.Copy Destination:=WshCible.[A1]

VersementOK = True

End Sub

Rechercher des sujets similaires à "chargement fichiers"