Problème pour copié une plage de cellule

[JeanMikael]

Bonjour à tous je suis nouveau sur ce forum et également débutant en VBA
et après avoir écumé plusieurs dizaines de post pour essayé de résoudre mon problème sans succès je me tourne vers vous.

Voici mon problème :

J'aimerai copier une plage de celulle dont le titre de la colonne est "NPSI"
et je voudrai copier toutes les lignes ou l'on retrouve la valeur "3004" de la colonne "NPSI" dans une nouvelle feuille appelé "Cat 1" ,j'espère avoir été clair j'attends avec impatience vos réponses
parceque là je galère vraiment.

Merci d'avance

Cordialement Jean-Mikaël

[Staple1600]

Bonjour

Voila une solution (par filtre automatique)

Avant de tester la macro
Il faut nommée ton titre de colonne (nécessaire pour cette macro)
Tu sélectionnes ta cellule puis
Insertion/Noms/Définir et la tu saisis: ColNPSI

Ensuite tu lancer ta macro

(il ne faut pas qu'il existe déjà une feulle nommée Cat 1, car elle est créer par la macro)

Sub tester()
'Déclarations des variables
Dim rng As Range
'définition d'une plage de cellule (ici contenant une seule cellule)
Set rng = [ColNPSI] ''zone nommée ici l'entete de la colonne NPSI
'filtre automatique
rng.AutoFilter 1, "3004"
'copie du résultat du filtre
rng.CurrentRegion.Copy
'ajout d'une feuille
Sheets.Add
'renommage de la feuille nouvellement créée
ActiveSheet.Name = "Cat 1"
'collage spécial: uniquement les valeurs
ActiveSheet.[A1].PasteSpecial xlValues, xlNone, False, False
Application.CutCopyMode = False
Set rng = Nothing
End Sub

En espérant t'avoir aidé
Et en attendant de lire des solutions plus élégantes

A+

Staple

edit: une réponse plus élégante n' a pas tardé, bonjour Eric 45

[Eric 45]

Bonjour à tous
Bonjour JeanMikael

Tout d'abord bienvenu parmi nous

Tu peux essayer ce code :

Dim a As Integer
Dim c
Dim firstAddress
Dim ligne As String
Dim ligne01 As Integer
Dim ligne02 As String
Dim num_ref As Integer

Sub copie()
num_ref = 3004    'reprendre si pas cette référence
a = Worksheets("Cat 1").Range("A1:A65536").End(xlDown).Row + 1
With Worksheets("Feuil1").Range("c1:c65536")    'reprendre "Feuil1" et "c.."
    Set c = .Find(num_ref, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            ligne01 = c.Row
            ligne = ligne01 & ":" & ligne01
            ligne02 = a & ":" & a
            Worksheets("Cat 1").Rows(ligne02).Value = Worksheets("Feuil1").Rows(ligne).Value
            a = a + 1
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
    a = 0
End With
End Sub

n'oublie pas les quelques modif : nom de feuille active, nom de colonne

Eric

PS pas rafraichi, je suis mauvais aujourd'hui désolé Staple

[JeanMikael]

Désolé d'avoir été si long pour répondre ( parti mangé ) Je test vos macro et je vous tient au courant merci beaucoup pour votre aide j'apprécie vraiment .

[JeanMikael]

Les codes fonctionnent tout les deux !
Un grand merci à Eric et a Staple vous m'avez rendu un grand service merci encore et à bientot car je vais surement re-poster