kabol  | Pour les passionnés, je vous donne un bout de code qu'un certain Mercatog m'a gentil fournit sur un autre forum:
  
  Code :
 - '---------------------------------------------------------------------------------------
 - 'Sub qui permet de copier les données de la feuille SOURCE vers la feuille DESTINATION et reformatage des données suivant les explications fournies
 - '//!\\ Adapter dans cette sub les noms des 2 feuilles SOURCE et DESTINATION
 - '      Adapter aussi les mots  TitreC  et  vache
 - '---------------------------------------------------------------------------------------
 - '
 - Private Sub FormaterDonnees()
 - Dim c As Range, v As Range
 - Dim i As Integer
 - Dim Tb
 - Application.ScreenUpdating = False
 - 'On efface le contenu éventuel de la feuille Destination
 - Worksheets("DESTINATION" ).UsedRange.Clear
 - With Worksheets("SOURCE" )
 -     'On recherche la colonne TitreC
 -     Set c = .UsedRange.Find("TitreC", LookIn:=xlValues, lookat:=xlWhole)
 -     If Not c Is Nothing Then
 -         c.CurrentRegion.Copy Worksheets("DESTINATION" ).Range("A1" )
 -         Set c = Nothing
 -     End If
 - End With
 - With Worksheets("DESTINATION" )
 -     'Suppression des colonnes D ensuite B
 -     .Columns(4).Delete
 -     .Columns(2).Delete
 -     Set c = .Range("A1" ).CurrentRegion
 -     'Suppression des lignes ne contenant pas vache en colonne TitreA (colonne 1)
 -     Call SupprFiltre(c, 1, "vache" )
 -     'Suppression des lignes vides de la colonne TitreC (Colonne 2, qui était colonne 3 avant la suppression de la colonne TitreB)
 -     Call SupprFiltre(c, 2, "*" )
 -     'On éclate les nombres séparés par le point dans les colonnes D,E et F
 -     For Each v In Intersect(c, .Range("B:B" ))
 -         Tb = Split(v, "." )
 -         For i = 0 To UBound(Tb)
 -             v.Offset(0, i + 2) = Tb(i)
 -         Next i
 -     Next v
 -     Set c = c.Resize(c.Rows.Count, c.Columns.Count + 3)
 -     'On tri sur D, puis E enfin F
 -     c.Sort Key1:=.Range("D1" ), Order1:=xlAscending, Key2:=.Range("E1" ), Order2:=xlAscending, Key3:=.Range("F1" ), Order3:=xlAscending, Header:=xlYes
 -     'On insère une ligne entre sections
 -     Call SepareSections(c)
 -     'On supprime les colonnes D,E et F
 -     .Range("D:F" ).EntireColumn.Delete
 -     Set c = Nothing
 - End With
 - End Sub
 - '---------------------------------------------------------------------------------------
 - 'Sub qui permet de supprimer les lignes de LaPlage
 - 'dont les cellules de la colonne LaColonne ne répondant
 - 'pas au critères LeCritere
 - '---------------------------------------------------------------------------------------
 - '
 - Private Sub SupprFiltre(LaPlage As Range, ByVal LaColonne As Integer, ByVal LeCritere As String)
 - With LaPlage
 -     .AutoFilter Field:=LaColonne, Criteria1:="<>" & LeCritere
 -     .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
 -     .Parent.AutoFilterMode = False
 - End With
 - End Sub
 - '---------------------------------------------------------------------------------------
 - 'Sub qui permet d'insérer une ligne de titre entre chaque section
 - '---------------------------------------------------------------------------------------
 - '
 - Private Sub SepareSections(Plage As Range)
 - Dim i As Integer, N As Integer
 - With Plage
 -     N = .Rows.Count
 -     With .Parent
 -         For i = N To 2 Step -1
 -             If .Range("D" & i) <> .Range("D" & i - 1) Then
 -                 .Rows(i).Insert
 -                 .Range("A" & i) = "SECTION " & .Range("D" & i + 1)
 -                 With .Range("A" & i & ":C" & i)
 -                     .HorizontalAlignment = xlCenterAcrossSelection
 -                     .Font.Bold = True
 -                 End With
 -             End If
 -         Next i
 -     End With
 - End With
 - End Sub
 
  |  
 
     Merci d'avance pour toute aide complémentaire ou remarque.
   Bonne journée,
  
     |