Option Explicit
Dim Mess As Integer, r As String
Dim xnomfic As String, ficd As String, xcell As String, xnomsh As Variant
Dim i As String
Dim xshcherchee As Worksheet
Dim classeur As Workbook
Dim wb As Workbook
Dim ws As Worksheet
Function FichierExiste(ficd) As Boolean
FichierExiste = Dir(ficd) <> "" And ficd <> ""
End Function
Sub Muscudétail()
Application.DisplayAlerts = False
r = Feuil1.[D1]
If Dir("C:\Users\coach\dropbox\joueurs\" & r, vbDirectory) = "" Then _
MkDir "C:\Users\coach\dropbox\joueurs\" & r
Application.ScreenUpdating = False
xnomfic = Range("D1"): ficd = xnomfic & " Musculation.xlsx"
' Contrôle de l'existence du fichier ou classeur
If FichierExiste("C:\Users\coach\dropbox\joueurs\" & r & "\" & ficd) = "Vrai" Then
'sélection du classeur cible et copies des cellules F2 de chaque feuille
Application.Workbooks.Open("C:\Users\coach\joueurs\" & r & "\" & ficd).Activate
For i = 1 To Worksheets.Count
Workbooks("Classeur1").Sheets(Feuil1).Range("A1").Offset(i, 0).Value = Worksheets(i).[F2].Value
Next i
'collage des cellules copiée dans la colonne A de la feuille 1
Workbooks("Classeur1").Activate
Feuil1.Activate
Range("A:A").Select
ActiveSheet.Paste
Feuil1.Activate
End If
End Sub