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 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
| Sub TEST()
Dim wk, wk2 As Workbook
Dim ws, ws2 As Worksheet
Dim pth, prf1, prf2, prf3, suf, chemin, nom, Fichier As String
Dim dat, dat2 As Date
Dim derlign As Variant
derlign = Range("A1048576").End(xlUp).Row - 1
' pth = "\\spvcertipost001\Expensys\Fedcom\2020\SPV\source_rapports_budget\source_rapport_krc\"
pth = "P:\VBA\BETA_KRC\file\"
suf = ".XLSX"
prf1 = "ZBUDRAP_"
prf2 = "ZBUDRAPCV_"
prf3 = "S_P99_ALL_ "
Set wk = ThisWorkbook
Set ws = wk.Worksheets("Feuil1")
dat = CDate("1900/01/01")
nom = Dir(pth & prf1 & "*" & suf)
Do While nom > ""
nom = Trim(Replace(Replace(nom, prf1, ""), suf, ""))
If IsNumeric(nom) And Len(nom) = 8 Then
If IsDate(Format(nom, "####/##/##")) Then
dat2 = CDate(Format(nom, "####/##/##"))
If dat2 > dat Then Fichier = pth & prf1 & nom & suf: dat = dat2
End If
End If
nom = Dir
Debug.Print nom
Loop
Debug.Print Fichier
Set wk2 = Workbooks.Open(Fichier, ReadOnly:=True)
wk2.Worksheets("Sheet1").Range("A2:A" & derlign).Copy
ws.Range("A2").Paste
wk2.Close True
Set wk2 = Nothing
End Sub |
Partager