Copier ligne sur une autre feuille avec condition

popcorn

XLDnaute Occasionnel
Bonjour le forum,

J'ai une colonne qui contient plusieurs fois la même valeur, une référence.
Je souhaiterai copier les lignes dont les cellules de cette colonne sont identiques sur une autre feuille.
Une feuille par référence.

J'ai un bout de code qui me permet d'extraire les lignes après avoir saisi la référence dans une inputbox.

J'aimerai que la macro détecte les cellules identiques, copie les lignes et creer une feuille par référence, sans avoir à saisir sa valeur.

Code:
Sub extraction()
Dim c As Range
Dim box As String
Dim derlig As Long
box = InputBox("Saisie du numero de palette : ", "Palette")
    If box <> "" Then
    With Sheets("Liste")
           With ActiveSheet
        If Not .AutoFilterMode Then .Range("B1").AutoFilter
        End With
            'la ligne de la dernière cellule remplie de la colonne B de feuille Base
            derlig = .Cells(.Rows.Count, "A").End(xlUp).Row
            With .Range("B2:B" & derlig)
                'On filtre sur la colonne 2 de la feuille Liste, en prenant comme critère la valeur de box
              .AutoFilter Field:=2, Criteria1:=box
                'On copie les lignes issues du filtre auto
                .SpecialCells(xlCellTypeVisible).EntireRow.Copy
            End With
            'On enlève notre filtre automatique
            .AutoFilterMode = False
        End With
               Worksheets.Add(After:=Worksheets(Worksheets.Count)).Paste
              ActiveSheet.Name = Range("B2")
              Columns.AutoFit
        End If
End Sub

Merci de votre aide.
 

Pièces jointes

  • test_copie_ligne.xlsm
    2.6 MB · Affichages: 51

Statistiques des forums

Discussions
312 206
Messages
2 086 203
Membres
103 157
dernier inscrit
youma