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

Discussions similaires

Réponses
7
Affichages
292
Réponses
2
Affichages
129

Statistiques des forums

Discussions
311 725
Messages
2 081 949
Membres
101 852
dernier inscrit
dthi16088