Bonjour,
Un test suite aux dernières informations :
Sub TRANSFO()
Dim L%, C%, WB As Workbook
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ThisWorkbook.Worksheets(1).UsedRange.ClearContents
With Application.FileDialog(msoFileDialogOpen)
.Title = "Selectionner votre fichier à transformer"
If .Show = -1 Then
Set WB = Workbooks.Open(.SelectedItems(1))
Else
MsgBox "Aucun fichier sélectionné, fin de la procédure"
Exit Sub
End If
End With
L = 2
With WB.Worksheets(1)
.Range("I:K").NumberFormat = "@"
Do
If .Cells(L, 8) Like "*<br/>*" Then
.Rows(L + 1).Insert xlDown
.Rows(L & ":" & L + 1).FillDown
Application.Union(.Cells(L + 1, 6), .Range(.Cells(L + 1, 10), .Cells(L + 1, 15))).ClearContents
For C = 6 To 10
If InStr(1, .Cells(L, C), "<br/>") > 0 Then .Cells(L, C) = Left(.Cells(L, C), InStr(1, .Cells(L, C), "<br/>") - 1)
If InStr(1, .Cells(L + 1, C), "<br/>") > 0 Then .Cells(L + 1, C) = Mid(.Cells(L + 1, C), InStr(1, .Cells(L + 1, C), "<br/>") + 5, Len(.Cells(L + 1, C)))
Next C
End If
L = L + 1
Loop Until .Cells(L, 2) = ""
.UsedRange.Copy
End With
With ThisWorkbook.Worksheets(1)
.[A1].PasteSpecial xlPasteValues
For C = 9 To 11
.Columns(C).TextToColumns .Cells(1, C), FieldInfo:=Array(1, 1), DecimalSeparator:="."
Next C
.Columns("A:O").AutoFit
End With
WB.Close False
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Transformation finalisée"
End Sub
Cdlt,