Discussion :

[patine31]

Bonjour,

j'ai un tableau général :

code Nom blabla bla bla recette dépense

to toto qsfqskf fqfdqfd 50
to toto qsfqskf fqfdqfd 25
pa patine dsqdq dqfsqdf 100
pa patine dsqdq dqfsqdf 30
aa alain dsqdq dqfsqdf 100
je jean dsqdq dqfsqdf 100
pi Pierre dsqdq dqfsqdf 100

je cherche a créer une macro qui me renvoie les lignes concernant d'une seule personne vers un nouveau fichier, avec le même haut du tableau.

ex :

code Nom blabla bla bla recette dépense

to toto qsfqskf fqfdqfd 50
to toto qsfqskf fqfdqfd 25

Le nouveau classeur devra porter le nom de la personne et la date du jour ou la macro a été lancer.

toto 15 03 2007

Merci beaucoup pour votre aide.

@ Bientôt.

Patine

[alsimbad]

et c'est quoi la question?

[dadavyvy]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub CopyToNewWbk()
    Dim wks As Worksheet, rg As Range, wkb As Workbook
    Set wks = Feuil1 ' la feuille ou sont les donnees
    Set rg = wks.Range("1:1") ' la ligne ou il y a les titres de colonne
    nom = "toto" ' nom a extraire
    nCol = 2 ' colonne ou se trouve le nom
 
    ' extrait les lignes verifiant le critere
    For i = 2 To wks.UsedRange.Rows.Count
        If wks.Cells(i, nCol) Like nom Then
            Set rg = Union(rg, wks.Range(i & ":" & i))
        End If
    Next i
 
    ' cree un nouveau classeur
    Application.ScreenUpdating = False
    Set wkb = Workbooks.Add
    wkb.Windows(1).Visible = False
    ' copie vers le nouveau classeur
    rg.Copy wkb.Worksheets(1).Cells(1, 1)
    wkb.Windows(1).Visible = True
    Application.ScreenUpdating = True
 
    Set rg = Nothing
    Set wks = Nothing
    Set wkb = Nothing
End Sub