Sub récup_données()
Dim Wb As Workbook
Dim Wkb As Workbook
Dim rep As String, Nom_fic(20) As String
Application.ScreenUpdating = False
'Call remiseàblanc
'Récup Liste des fichiers
rep = "C:\Users\Fives\Desktop\Puce\BDD"
nom = ActiveWorkbook.Name
Direction = Dir(rep & "\*.xlsx")
nbfic = 0
While Direction > ""
nbfic = nbfic + 1
Nom_fic(nbfic) = Direction
'MsgBox Nom_fic(nbfic) & " = " & nbfic
Direction = Dir()
Wend
'Stop
'Ouverture
For X = 1 To nbfic
fg = Nom_fic(X)
If fg = nom Then GoTo suite
Dim cpt As Integer
On Error Resume Next
WOuvert = False
' Parcours des classeurs ouverts
For Each Wkb In Workbooks
If Wkb.Name = fg Then
WOuvert = True
cpt = 1
Exit For
End If
Next Wkb
If cpt = 1 Then cpt = 0: GoTo fin
chemin = rep & "\" & fg
If Left(fg, 5) <> "Datas" Then GoTo suite
Workbooks.Open chemin
fin:
Windows(fg).Activate
Sheets("Datas").Activate
derligne = Sheets("Datas").Range("A65536").End(xlUp).Row
dercol = 7
Range(Cells(1, 1), Cells(derligne, dercol)).Select
Selection.Copy
Windows(nom).Activate
Sheets("Datas").Activate
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows(fg).Activate
Application.DisplayAlerts = False
ActiveWorkbook.Close
suite:
Next X
'Stop
Application.DisplayAlerts = True
'Stop
Sheets("Facture").Activate
End Sub