Option Explicit
Sub GPS()
Dim LeChemin As String
Dim LeChemin1 As String
Dim Del As Integer
Dim DerL As Integer
Dim c As Range, d As Range, e As Range, f As Range, g As Range, h As Range, i As Range, j As Range, k As Range, x As Range, aa As Range
Application.ScreenUpdating = False
LeChemin = "E:\cendre fiches.csv" 'C'est ici qu'i faut modifier le chemin
LeChemin1 = "E:\cendre wpts.csv"
Application.DisplayAlerts = False 'C'est ici qu'i faut modifier le chemin
With ThisWorkbook
.Sheets("WPT").Cells.Clear
.Sheets("FICHE").Cells.Clear
.Sheets("WPT").Select
With .Sheets("WPT").QueryTables.Add(Connection:= _
"TEXT;" & LeChemin1, Destination:=Range("$A$1"))
.Name = "Wpts"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.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)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
.Sheets("FICHE").Select
With .Sheets("FICHE").QueryTables.Add(Connection:= _
"TEXT;" & LeChemin, Destination:=Range("$A$1"))
.Name = "Fiches"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.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)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
Rows("1:2").Delete
End With
Application.DisplayAlerts = True
'On split en C la colonne B de la feuille "WTP" au -
With Sheets("WPT")
.Columns("C").Insert
Set c = .Range("C2")
Do While c.Offset(0, -1) <> ""
c = Split(c(1, 0), "-")(0)
Set c = c.Offset(1, 0)
Loop
'On copie les valeur de C dans feuille "Finale" colonne G
.Range("C2:C65000").Copy Worksheets("Finale").Range("G4")
End With
With Sheets("Finale")
'A prtir d'ici toutes les formules Excel sint remplacées par des formules VBA
'Remplace fonction rechercheV
Set d = .Range("H4:H" & .Range("G65536").End(xlUp).Row)
Set e = .Range("I4:I" & .Range("G65536").End(xlUp).Row)
d.Formula = "=VLOOKUP($G4,WPT!$C$2:$F$65536,3,0)"
e.Formula = "=VLOOKUP($G4,WPT!$C$2:$F$65536,4,0)"
d.Value = d.Value
e.Value = e.Value
'Remplace fonction Si
Set f = .Range("J4:J" & .Range("G65536").End(xlUp).Row)
Set g = .Range("K4:K" & .Range("G65536").End(xlUp).Row)
f.Formula = "=IF(FICHE!R[-2]C[-2]=""DEBUT"",WPT!R[-1]C[-5],FICHE!R[-2]C[-2])"
g.Formula = "=IF(FICHE!R[-2]C[-3]=""DEBUT"",WPT!R[-1]C[-5],FICHE!R[-2]C[-3])"
f.Value = f.Value
g.Value = g.Value
Set h = .Range("L4:L" & .Range("G65536").End(xlUp).Row)
Set i = .Range("M4:M" & .Range("G65536").End(xlUp).Row)
Set j = .Range("N4:N" & .Range("G65536").End(xlUp).Row)
h.Formula = "=IF(FICHE!R[-2]C[-3]="" "","" "",FICHE!R[-2]C[-3])"
i.Formula = "=IF(FICHE!R[-2]C[-3]="" "","" "",FICHE!R[-2]C[-3])"
j.Formula = "=IF(FICHE!R[-2]C[-3]="" "","" "",FICHE!R[-2]C[-3])"
f.Value = f.Value
g.Value = g.Value
h.Value = h.Value
i.Value = i.Value
j.Value = j.Value
'Va chercher les valeur de la feuille FICHE
Set x = .Range("X4:X" & .Range("G65536").End(xlUp).Row)
Set aa = .Range("AA4:AA" & .Range("G65536").End(xlUp).Row)
'On renvoi la colonne T de la feuille Fiche
x = "=FICHE!R[-2]C[-4]"
'On renvoi la colonne U de la feuille Fiche
aa = "=FICHE!R[-2]C[-6]"
x.Value = x.Value
aa.Value = aa.Value
'On supprime toutes les lignes où le mot "FIN" figure en colonne J
For Del = Range("J65536").End(xlUp).Row To 1 Step -1
If Cells(Del, 10).Value = "FIN" Then Cells(Del, 10).EntireRow.Delete
Next Del
End With
End With
Application.ScreenUpdating = True
End Sub
