Sub Extract()
Dim MonFichier As String 'Extraction du fichier texte
MonFichier = Application.GetOpenFilename
Workbooks.Open MonFichier
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;S:\prestation\STAGIAIRES\Marc\Dossier Extract temps\Nouveau Document texte.txt" _
, Destination:=Range("A1"))
.Name = "Fichier extrait"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With 'Fin de l'extraction du fichier texte
Columns(16).Delete 'Là je supprime les colonnes inutiles.
Columns(17).Delete
Columns(18).Delete
Columns(19).Delete
Columns(20).Delete
Columns(21).Delete
Columns(22).Delete
Columns(23).Delete
Columns(24).Delete
Columns(25).Delete
Columns(26).Delete
Dim intI As Integer 'Suppression des lignes vides (c'est à dire les personnes n'ayant pas travaillées ont un 0 dans la colonne des heures effectuées)
intI = 3
Do While Cells(intI, 14) <> "FIN" 'Je ne peux pas mettre "" car il y a des lignes vides dans le tableau entre les personnes
If Cells(intI, 14) = 0 Then
Rows(intI).Delete
Else
intI = intI + 1
End If
Loop
Windows("Nouveau document texte.txt").Activate 'Récupération du fichier texte
Range("A1:O500").Select
Selection.Copy
Windows("Essai macro.xls").Activate
Sheets("Feuil2").Select
ActiveSheet.Paste
Range("Q4").Select 'Création de la colonne des heures
ActiveCell.FormulaR1C1 = "=RC[-3]/60"
Range("Q4").Select
Selection.AutoFill Destination:=Range("Q4:Q413"), Type:=xlFillDefault
Range("Q4:Q413").Select
Dim Nom As String, i As Long, j As Long
Sheets(1).Select
i = 4
With Sheets(2)
Do While Cells(i, 2) <> "FIN" 'Ligne (i,A)
Nom = Cells(i, 2)
For j = 4 To .Range("B65536").End(xlUp).Row
If Nom = .Cells(j, 2) Then
With Worksheets("Feuil1").Range("A2:Z2")
'Enregistrer dans une variable la date du jour.
Set datejour = Worksheets("Feuil2").Range("E4")
'Rechercher la date du jour dans la feuille Calcul
Set datej = .Find(datejour, LookIn:=xlFormulas)
'Définir et enregistrer dans une variable le numéro de la ligne de la date trouvée dans la feuille Calcul
Dim X As Integer
X = datej.Column
'Copier/Coller les données F400 du formulaire vers la feuille de calcul
Worksheets("Feuil2").Range("Q4:Q200").Copy
ActiveSheet.Paste Destination:=Worksheets("Feuil1").Range(.Cells(4, X + 1), .Cells(200, X + 1))
End With
Exit For
End If
Next
i = i + 1
Loop
End With
End Sub