Macro excel Filtrage et copie

Question

Bonjour à tous , 

débutant en VBA, j'ai fait un Inputbox, la valeur de l'inputbox sert à faire un filtre, j'aimerai ensuite que les lignes visibles soient copiées dans un onglet créé avec le même nom que l'inputbox. Et ce pour l'onglet 2 à .... (très variable).

Voici le code réalisé : 

Sub filtre()
    
    Dim rngSelect   As Range
    Dim I As Integer
    
    typedaction = InputBox("Choix du type d'action", "Filtre des actions")
    
    Worksheets("Trame").Select
    Worksheets("Trame").Copy After:=Sheets(1)
    Worksheets("Trame").Select
    Worksheets("Trame (2)").Select
    Worksheets("Trame (2)").Name = typedaction
    
    For I = 2 To Worksheets.Count
        
        Sheets(I).Select
        Range("A1").Select
    
        ' filtrage
        Selection.AutoFilter Field:=16, Criteria1:=typedaction
        ' rngSelect =   toutes les cellules visibles (non masquées par le filtre)
        '               contigües à la cellule active
        Set rngSelect = ActiveCell.CurrentRegion.SpecialCells(xlCellTypeVisible)
    
        ' copy de la zone sélectionnée
        Worksheets("typedaction").Select
        Cells(65535, 1).End(xlUp)(2, 0).Range.Select
        rngSelect.Paste
        Set rngSelect = Nothing
        
    Next I
    
End Sub

Le nouvel onglet avec le nom de l'inputbox est bien crée mais après ça me donne erreur 400

Si vous avez une solution je suis preneur


Configuration: Windows XP / Firefox 3.6.8

lermite222 · Answer

Bonjour, 
Le mot clé After ne peu être employer qu'en dernière feuille, si tu à 3 feuilles tu peu mettre After:=Sheets(3) 
Mais si il est possible d'avoir une feuille ou plusieur il faut tester... 
Tu peu remplacer ta copie par... 
Sub CopierFeuille() 
Sheets("feuil1").Copy before:=Sheets(1) 
    With ActiveSheet 
        .Name = typedaction  
        If Sheets.Count > 2 Then 
            .Move before:=Sheets(3) 
        Else 
            .Move After:=Sheets(2) 
        End If 
    End With 
End Sub
A+ 
L'expérience instruit plus sûrement que le conseil. (André Gide)   
Si tu te cognes à un pot et que ça sonne creux, c'est pas forcément le pot qui est vide. ;-)(Confucius)

jehafa · Answer

j'ai intégrer ton code au miens mais ça ne fonctionne toujours pas. La copie du nouvel onglet ce fait bien fait ça doit être au niveau du filtre.

Maintenant j'ai une erreur d'exécution '9' : L'indice n'appartient pas à la sélection. 

Une idée ??


Sub filtre()
    
    Dim rngSelect   As Range
    Dim I As Integer
    
    typedaction = InputBox("Choix du type d'action", "Filtre des actions")
    
    Worksheets("Trame").Select
    Worksheets("Trame").Copy before:=Sheets(1)
    With ActiveSheet
        .Name = typedaction
        If Sheets.Count > 2 Then
            .Move before:=Sheets(3)
        Else
            .Move After:=Sheets(2)
        End If
    End With

    Worksheets("Trame").Select
    Worksheets("Trame (2)").Select
    Worksheets("Trame (2)").Name = typedaction
    
    For I = 2 To Worksheets.Count
        
        Sheets(I).Select
        Range("A1").Select
    
        ' filtrage
        Selection.AutoFilter Field:=16, Criteria1:=typedaction
        ' rngSelect =   toutes les cellules visibles (non masquées par le filtre)
        '               contigües à la cellule active
        Set rngSelect = ActiveCell.CurrentRegion.SpecialCells(xlCellTypeVisible)
    
        ' copy de la zone sélectionnée
        Worksheets("typedaction").Select
        Cells(65535, 1).End(xlUp)(2, 0).Range.Select
        rngSelect.Paste
        Set rngSelect = Nothing
        
    Next I
    
End Sub

Macro excel Filtrage et copie

2 réponses

Discussions similaires

Newsletters