Copier ligne dans une nouvelle feuille si Fermé

Question

Bonjour, 

Voici mon cas, j'ai une base de donnée avec dans une des colonnes le nom de l'utilisateur et j'aimerais que mon code VBA me copie dans une nouvelle feuille toutes les lignes avec le nom choisi 

je déclare un variable avec le nom désiré mais après je ne sais pas comment coder le fait de copier les lignes où il y a le nom choisi.

Merci d'avance

Thomas

Configuration: Windows 8 / Chrome 36.0.1985.143

PlacageGranby · Answer

Dans cet exemple, 
remplace  feuil1 par le nom de la feuille ou ta base de données est.
remplace feuil2 par le nom de la feuille ou tu veux copier les données
Le nom à copier est entrée dans la case A1  donc la copie peut être dynamique.
On suppose que les données commemence à la ligne 4 et sont copié à la ligne 4, 
On suppose qu'il n'y a pas de blanc dans la base de donnée,  on copie, et la boucle s'arrête lorsqu'un vide est trouvé.
S'il y a des vide, il faut être créatif,  rechercher  durant 500 ligne,  ou ajouter un FIN après le tableau et s'arrêter lorsqu'on trouve FIN.

L'exemple ne fait peut-être pas exactement ce que tu veux, mais tu peux adapter ce code selon tes besoins.  Selon ou commencer les données,  dans quel colonne est le nom.  
Si tu veux que le nom choisi soit dynamique ou hard-codé  (écrire Nom_choisi = "Sylvain".

Sub Macro3()

Dim Nom_Choisi As String
Dim Debut_Tableau As Integer
Dim Nouveau_tableau As Integer

Debut_Tableau = 4
Nouveau_tableau = 4

Nom_Choisi = Sheets("feuil1").Range("A1").Value

While Sheets("feuil1").Range("A" & Debut_Tableau).Value <> ""
    If Sheets("feuil1").Range("A" & Debut_Tableau).Value = Nom_Choisi Then
        Sheets("Feuil2").Rows(Nouveau_tableau).Value = Sheets("Feuil1").Rows(Debut_Tableau).Value
        Nouveau_tableau = Nouveau_tableau + 1
    End If
    Debut_Tableau = Debut_Tableau + 1
Wend

End Sub

michel_m · Answer

Bonjour

maquette de W ci jointe:
https://www.cjoint.com/?3IikGU5F7wT

sans aucune précision de ta part :-(  
 le nom recherché est dans une cellule nommée "nom", de m^me la ligne d'ent^te est en constante ainsi que la colonne des noms dans le code à adapter, enfin la feuille de base de données est nommée "bdd"

principe
on vérifie que le nom inscrit est bien dans la base de données (gestionnaire d'erreurs)
on ne boucle que sur les lignes où il y a le nom 
et on les mémorise dans une variable tableau

On construit la feuille avec comme nom d'onglet le nom recherché
on copie la ligne d'entête et on restitue la variable tableau
on encadre le tableau

le code
Option Explicit
Option Base 1
'--
Const Col As Byte = 1 'colonne de recherche
Const Lig_ent As Byte = 3 'ligne des entêtes
'-----------
Sub selectionner_selon_nom()
Dim Qui As String, Dercol As Byte, Nbre As Integer, Entete
Dim Lig As Integer, Idy As Integer, Idx As Byte, T_qui()

'----------------initialisations
Application.ScreenUpdating = False
With ActiveSheet
     Qui = Range("nom") 'cellule nommée (adresse nom précisée dans la demande !)
     Dercol = .Rows(Lig_ent).Find("*", , , , , xlPrevious).Column
     'verif nom existant
     Nbre = Application.CountIf(.Range(.Cells(Lig_ent, Col), .Cells(10000, Col)), Qui)
     If Nbre = 0 Then GoTo Vide
     ReDim T_qui(Nbre, Dercol - Col + 1) 'tableau des lignes avec "qui"
     'mémorise la ligne d'ent^te
     Entete = .Range(.Cells(Lig_ent, Col), .Cells(Lig_ent, Dercol))
     
 '---------------------traitement sur feuille database
     ' recherche les lignes  avec "Qui"
     Lig = Lig_ent
     For Idy = 1 To Nbre
          Lig = .Columns(Col).Find(Qui, Cells(Lig, Col), xlValues).Row
     'mémorisation  des données à copier
          For Idx = Col To Dercol
               T_qui(Idy, Idx) = .Cells(Lig, Idx)
          Next Idx
     Next Idy
End With

'------------------construction de la feuille "qui"
Sheets.Add
With ActiveSheet
     .Move After:=Sheets("Bdd") ' A adapter nom de l'onglet base de données
    .Name = Qui
    .Range(.Cells(Lig_ent, Col), .Cells(Lig_ent, Dercol)) = Entete 'entêtes
     .Cells(Lig_ent + 1, Col).Resize(Nbre, Dercol - Col + 1) = T_qui 'restitution données de "qui"
     .Range(.Cells(Lig_ent, Col), .Cells(Lig_ent + Nbre, Dercol)).Borders.Weight = xlThin 'encadrement
End With
Exit Sub

'----------------gestionnaire d'erreur
Vide:
     MsgBox Qui & " Inconnu !", vbCritical
End Sub

 
 Michel

michel_m · Answer

Merci ?
de rien...

Copier ligne dans une nouvelle feuille si

3 réponses

Discussions similaires