Extraction avec filtre Onglets

Bonsoir a tous,

J'aurai besoin de votre aide afin d'extraire a partir de la feuille 1 et en me basant sur la colonne C .

Ce que je souhaite realiser c'est extraire les lignes detous les mots "JUPITER" sur la feuille2 et le mots "MARS" sur la feuille 3

je vous joint un fichier comme exemple

Merci d'avance de votre aide

7classeur1.xlsx (9.92 Ko)

Bonsoir,

Faut-il les supprimer de la première feuille ?

Re,

Tu testes en cliquant sur le bouton.

Sub AstralMacron()
    Dim aa, jup(), mar(), j%, m%, i%, clr&
    aa = ActiveSheet.Range("A2").CurrentRegion
    ReDim jup(0): j = 1
    jup(0) = WorksheetFunction.Index(aa, 1, 0)
    ReDim mar(0): m = 1
    mar(0) = WorksheetFunction.Index(aa, 1, 0)
    For i = 2 To UBound(aa)
        If aa(i, 3) = "JUPITER" Then
            ReDim Preserve jup(j)
            jup(j) = WorksheetFunction.Index(aa, i, 0)
            j = j + 1
            'aa(i, 1) = Empty
        ElseIf aa(i, 3) = "MARS" Then
            ReDim Preserve mar(m)
            mar(m) = WorksheetFunction.Index(aa, i, 0)
            m = m + 1
            'aa(i, 1) = Empty
        End If
    Next i
    clr = RGB(218, 238, 243)
    With Worksheets(2).Range("A1")
        .CurrentRegion.Clear
        With .Resize(j, UBound(aa, 2))
            .Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(jup))
            .Borders.Weight = xlThin
            .HorizontalAlignment = xlCenter
            With .Rows(1)
                .Interior.Color = clr
                .Font.Bold = True
            End With
        End With
    End With
    With Worksheets(3).Range("A1")
        .CurrentRegion.Clear
        With .Resize(m, UBound(aa, 2))
            .Value = WorksheetFunction.Transpose(WorksheetFunction.Transpose(mar))
            .Borders.Weight = xlThin
            .HorizontalAlignment = xlCenter
            With .Rows(1)
                .Interior.Color = clr
                .Font.Bold = True
            End With
        End With
    End With
    'With ActiveSheet
        'With .Range("A2").CurrentRegion
            '.Value = aa
            '.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        'End With
    'End With
End Sub

En l'état la macro ne supprime pas les JUPITER et MARS de Feuil1.

Pour qu'ils soient supprimés, activer les lignes du code qui sont désactivées : supprimer les apostrophes qui précèdent les lignes de code qui en ont une.

Cordialement.

Salut Mferrand.

Super comme d'habitude et je te remercie

Bonne journée

Bonsoir,

je souhaiterai convertir ces chiffres "3.04883E+11" en colonne E pour la feuille 2 et 3 en l'integrant dans ma macro

merci de votre aide

Rechercher des sujets similaires à "extraction filtre onglets"