Extraction avec filtre Onglets

Y compris Power BI, Power Query et toute autre question en lien avec Excel
D
Dehbi
Membre habitué
Membre habitué
Messages : 90
Inscrit le : 30 décembre 2017
Version d'Excel : 2010

Message par Dehbi » 23 juillet 2018, 23:23

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
Classeur1.xlsx
(9.92 Kio) Téléchargé 6 fois
M
MFerrand
Fanatique d'Excel
Fanatique d'Excel
Messages : 17'203
Appréciations reçues : 445
Inscrit le : 20 juillet 2015
Version d'Excel : 2010 FR

Message par MFerrand » 24 juillet 2018, 00:30

Bonsoir,

Faut-il les supprimer de la première feuille ?
M
MFerrand
Fanatique d'Excel
Fanatique d'Excel
Messages : 17'203
Appréciations reçues : 445
Inscrit le : 20 juillet 2015
Version d'Excel : 2010 FR

Message par MFerrand » 24 juillet 2018, 00:56

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.
dehbi_Classeur1.xlsm
(22.13 Kio) Téléchargé 7 fois
D
Dehbi
Membre habitué
Membre habitué
Messages : 90
Inscrit le : 30 décembre 2017
Version d'Excel : 2010

Message par Dehbi » 24 juillet 2018, 03:00

Salut Mferrand.

Super comme d'habitude et je te remercie

Bonne journée
D
Dehbi
Membre habitué
Membre habitué
Messages : 90
Inscrit le : 30 décembre 2017
Version d'Excel : 2010

Message par Dehbi » 25 juillet 2018, 02:32

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
dehbi_Classeur1.xlsm
(22.13 Kio) Téléchargé 2 fois
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message