Sub LireFichier3()
Application.ScreenUpdating = False
Dim LgSource As Range
Dim FDM_tmp() As String, FDM_list() As String
Dim row_nb As Integer
Dim SourceRange As Range
Dim destrange As Range
Dim j As Integer, f As Integer
Dim LDst As Long, FDst As Worksheet
Z1 = False
With Sheets("Feuil1").Range("F2:F1000").Select
ActiveCell.Interior.ColorIndex = -4142
'Initialisation du compteur de lignes de longlet source '
j = 2
'Initialisation du compteur du tableau dynamique'
f = 0
Do While Not (IsEmpty(ActiveCell))
'On récupère le nom de la FDM'
FDM_tmp = Split(ActiveCell.Value, "_")
'Si l'onglet nexiste pas'
If Onglet_exist(FDM_tmp(1)) = False Then
'Nom des onglets dans un tableau dynamique'
ReDim Preserve FDM_list(0 To f)
FDM_list(f) = FDM_tmp(1)
f = f + 1
' ActiveCell.Interior.ColorIndex = 3
Worksheets.Add After:=Sheets(ActiveWorkbook.Sheets.Count)
ActiveSheet.Name = FDM_tmp(1)
Set destrange = Sheets(FDM_tmp(1)).Range("A" & 2 & ":L" & 2)
'Si longlet existe'
Else
'Tweak pour éviter de parcourir les onglets pour compter le nombre de ligne'
Set FDst = Worksheets(FDM_tmp(1))
' Ligne qui suit le dernier F non vide'
LDst = FDst.[F65536].End(xlUp).Row + 1
Set destrange = Sheets(FDM_tmp(1)).Range("A" & LDst & ":L" & LDst)
End If
'Processus de copie de chaque ligne'
Set SourceRange = Sheets("Feuil1").Range("A" & j & ":L" & j)
SourceRange.Copy destrange
destrange.Interior.ColorIndex = -4142 'aucune couleur
Sheets("Feuil1").Select
'On incrémente le compteur dans la lecture de la feuille initiale'
j = j + 1
Selection.Offset(1, 0).Select
Loop
End With
For f = LBound(FDM_list) To UBound(FDM_list)
With Sheets(FDM_list(f))
'Formatage du header du tableau: titres et largeur des colonnes'
.Select
.Cells(1, 1).Value = "Chorus Version"
.Cells(1, 2).Value = "Test type"
.Cells(1, 3).Value = "Batch"
.Cells(1, 4).Value = "Item ID"
.Cells(1, 5).Value = "Test ID"
.Cells(1, 6).Value = "Test Name"
.Cells(1, 7).Value = "Test case description"
.Cells(1, 8).Value = "Total Steps"
.Cells(1, 9).Value = "Step#"
.Cells(1, 10).Value = "Step description"
.Cells(1, 11).Value = "Expected result"
.Columns("B:B").ColumnWidth = 15
.Columns("A:A").ColumnWidth = 8.14
.Columns("D:D").ColumnWidth = 7
.Columns("E:E").ColumnWidth = 6.14
.Columns("C:C").ColumnWidth = 7
.Columns("F:F").ColumnWidth = 26.14
.Columns("G:G").ColumnWidth = 45.71
.Columns("J:J").ColumnWidth = 12.29
.Columns("K:K").ColumnWidth = 24
.Columns("J:J").ColumnWidth = 23.57
'Formatage de chaque cellule des onglets : Centré et Retour automatique à la ligne'
.Cells.Select
With Selection
.WrapText = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
With Selection.Font
.Size = 10
.Name = "Tahoma"
End With
'Police utilisée et Couleur du header'
.Range("A1:L1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.399945066682943
.PatternTintAndShade = 0
End With
With Selection.Font
.Name = "Tahoma"
.FontStyle = "Gras"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
'Suppression des colonnes inutiles'
.Columns("A:D").Delete Shift:=xlToLeft
'Figer les volets jusqu'à la description du test'
With .Cells(1, 4).Select
'ActiveWindow.FreezePanes = False
ActiveWindow.FreezePanes = True
End With
End With
Next f
'Revenir au 1er onglet ajouté'
With Sheets(FDM_list(0))
.Select
End With
End Sub
'Fonction permettant de tester l'existence d'un onglet'
Private Function Onglet_exist(Nom As String) As Boolean
Dim sh As Worksheet
Onglet_exist = False
For Each sh In Sheets
If sh.Name = Nom Then
Onglet_exist = True
Exit For
End If
Next
End Function
