Extraire données d'un tableau pour créer un autre tableau

Option Explicit


Sub Ventile()
    Dim CurCell As Range, Titre As Range


    Application.ScreenUpdating = 0


    Columns("A:N").Sort Key1:=Range("N2"), Order1:=xlAscending, Header:=xlGuess
    Range("A1").Select


    Set CurCell = ThisWorkbook.Sheets("2012_Global").Range("N1")
    Set Titre = ThisWorkbook.Sheets("2012_Global").Range("A1:N1")


    While CurCell.Value <> vbNullString
        With GetSheet(CurCell.Value)
            Titre.EntireRow.Copy .Cells(1, 1)
            CurCell.EntireRow.Copy .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
        End With
        Set CurCell = CurCell.Offset(1, 0)
        Columns("A:N").Columns.AutoFit
    Wend


    Application.DisplayAlerts = 0
    Sheets("Colonne 14").Delete
    Application.DisplayAlerts = 1
    Sheets("2012_Global").Activate
End Sub


Public Function GetSheet(SheetName As String) As Worksheet
    Dim CurSheet As Worksheet, Exist As Boolean
    Exist = False
    For Each CurSheet In ThisWorkbook.Sheets
        If CurSheet.Name = SheetName Then Exist = True
    Next CurSheet
    If Not Exist Then
        ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = SheetName
    End If
    Set GetSheet = ThisWorkbook.Worksheets(SheetName)
End Function