Regrouper lignes paires et impaires

Bonjour à tous

voilà j'aimerais trouver un code vba qui me trierais le tableau ci joint j'ai un code vba qui me trie mais me laisse les colonnes séparées

en ne me gardant que' les numéros, les noms et les pourcentages

d'avance merçi tout le monde et bonne soirée

la feuille 1 avant et la feuille 2 après

Jacques

Bonjour,

Dans le fichier joint, cliquez sur le bouton "Importation et tri"

Cdlt

Un grand merçi Arturo 83 ça fonctionne nickel

une bonne Jounrée

Jacques

Re Arturo 83

encore une petite question si je veux trier un autre tableau juste en remettant dans l'ordre les lignes en colonne correctement sans trier les colonnes que je veux c'est à dire si j'ai le même type de tableau qui va de "A1" à "Z999" avec les lignes paires et impaires comme sur l'exemple

et que je veux juste remettre les lignes à la suite dans l'ordre entières qu'est ce qui change dans le code

Merçi d'avance

Jacques

Pas bien compris, pourriez-vous remettre le tableau avec un exemple de résultat attendu?

voilà je vous joins un tableau feuil 1 avant et feuil 2 après l'exécution de la macro , je n'ai pas tout recopié dans la feuil2 mais un échantillon du résultat souhaité

Encore merçi

Jacques

Voici le Nouveau code:

Sub Importation_Tri()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim i As Long, DerLig_f1 As Long
    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("Feuil2")
    f2.Cells.Clear 'effacement des précédentes importations triées
    DerLig_f1 = f1.Range("A1").CurrentRegion.Rows.Count  'Dernière ligne de la feuille "Pro"
    Range(f2.Cells(1, "A"), f2.Cells(DerLig_f1, "O")).Value = Range(f1.Cells(1, "A"), f1.Cells(DerLig_f1, "O")).Value 'Copie du tableau dans la feuille "Apres_Tri"
    For i = DerLig_f1 To 2 Step -1
        If f2.Cells(i, "A") = "" And f2.Cells(i - 1, "A") <> "" Then
            Range(f2.Cells(i, "A"), f2.Cells(i, "G")).Value = Range(f2.Cells(i, "H"), f2.Cells(i, "N")).Value 'Déplacement des données
        ElseIf f2.Cells(i, "A") = "" And f2.Cells(i, "I") <> "" Then
            Range(f2.Cells(i, "A"), f2.Cells(i, "G")).Value = Range(f2.Cells(i, "H"), f2.Cells(i, "N")).Value 'Déplacement des données
            i = i - 1
        End If
    Next i
    f2.Columns("I:J").Delete 'Suppression des données inutiles"
    Range(f2.Cells(2, "H"), f2.Cells(DerLig_f1, "N")).ClearContents
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

le fichier

Cdlt

Re

un grand Merçi et Bravo je vous remerçie ça fonctionne super

bonne journée

prenez soin de vous

Jacques