Discussion :

[frisette68]

Bonjour,

Je suis débutante et ai quand même essayé d'écrire une macro à partir d'exemples.
Suivant ce qu'il y a écrit dans la cellule K il me copie la ligne sur une feuille qui est déjà présente dans le classeur et que les copies s'incrémentent au fur et à mesure des ajouts. Dans un second temps je voudrai juste copier les colonnes A à J

Mais avant ça, il y a une erreur que je n'arrive pas à comprendre...
Je vous joins le fichier avec la macro test, si vous pouvoez m'aiguiller ce serait génial...

Merci.

[alsimbad]

salut
Evite les select. il faut savoir

Code :

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

1
2
3
4
5
 
range("a1").select
selection.copy
est la même chose que 
range("a1").copy

concernant ton pb
a adapter pour chaque case

Code :

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

1
2
3
4
   Case "Bureau"
            ActiveWorkbook.Sheets(Feuil1).Range("a" & (CStr(ligneF1) & ":" & "j" & CStr(ligneF1))).Copy Destination:= _
            Sheets(Feuil4).Range("A" & CStr(ligneF4))
            ligneF4 = ligneF4 + 1

[Qwazerty]

SAlut
Voila qui devrait te simplifier la vie

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
28
29
Sub Test2()
Dim CelTest As Range
Dim StrFeuil As String
Dim IntLigne As Integer
 
With Sheets("Général")
    'On va boucler sur les cellule de A9, jusqu'a la derniere ligne pleine de la colonne A
    For Each CelTest In .Range(.Range("A9"), .Cells(Rows.Count, "A").End(xlUp))
        'On va se decaler pour aller voir la valeur de la colonne K
        StrFeuil = CelTest.Offset(0, 10).Value
        'On evite un plantage sur une cellule qui serait vide
        If StrFeuil <> "" Then
            'On controle que ca n'est pas la 1er entrée que l'on fait dans le tableau
            'Je fait ca a cause des 2 lignes qui sont presente dans ton tableau et qui laissent donc 2 case vide dans la colonne A
            'Cases qui ne doivent bien sur pas etre prisent en compte.
            If Sheets(StrFeuil).Cells(Rows.Count, "A").End(xlUp).Row = 6 Then
                'On est dans le cas d'une 1ere saisi
                'On va donc effectuer la copy 2 lignes plus bas
                'On copy la ligne dans l'onglet correspondant
                CelTest.EntireRow.Copy Sheets(StrFeuil).Cells(Rows.Count, "A").End(xlUp).Offset(3, 0)
            Else
                'On copy la ligne dans l'onglet correspondant, a la suite des lignes deja saisies
                CelTest.EntireRow.Copy Sheets(StrFeuil).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
            End If
        End If
    Next
End With
 
End Sub

[Edit] Suite a un test je modifie le code, ça marchera mieux [/Edit]
A++
Qwaz

[frisette68]

Merci de ta réponse le code marche plutot bien. J'ai modifié des données d'entrée qui faisait planter le code mais maintenant ça fonctionne.

Mais il me reste une question lorsque l'on exécite le code dans l'onglet bureau il saute 2 lignes dans la copie et je n'arrive pas à comprendre pourquoi?

[Qwazerty]

SAlut
Pour le fait que 2 ligne sont sautées, c'est mon code qui le fait, en effet tu as modifier ton onglet Bureau, avant tu avais 2 lige a l'intérieur du tableau avec les numéro de compte sur le 1er et les entêtes de colonnes sur la 2eme.
Si personne ne corrige entre temps je regarde ça se soir ... la je vais être en retard au taff
Exprime bien ton besoin, comment doit être fait le table et est il bien identique sur toute les feuil.
J'ai fait une petit erreur en sautant 1ligne de trop, mais essai de comprendre le code et de le modifier.
A++
Qwaz

[Qwazerty]

SAlut
Alors j'ai remodifié, je pense que ce que tu dis avoir corrigé un peu plus haut ete les "mots clefs" que tu utilisés dans la colonne K, en effet fond de soucours, retraité,..., sont mal orthographié ce qui faisait planter la macro puisque les onglets correspondants n'existaient pas.
Pour le code on commance maintenant a la ligne 7 et non 9 ... tu avais juste a changer "A9" en "A7", un petit effort

Dans le tableau Bureau comme dans les autre je me decale bien de 3 ligne vers le bas pour ne pas reinscrire sur tes numero de comptes et tes entete de colonne en rouge et bleu.

Voici le code corrigé et un peu "amelioré" je pense, au lieu de copier la ligne complete on ne copie plus que de la colonne "A" à la colonne "J", le contenu de la colonne K etant je pense unitil dans les onglets triés.

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
28
29
30
31
32
33
34
Sub Test2()
Dim CelTest As Range
Dim StrFeuil As String
Dim IntLigne As Integer
 
With Sheets("Général")
    'On va boucler sur les cellule de A9, jusqu'a la derniere ligne pleine de la colonne A
    For Each CelTest In .Range(.Range("A7"), .Cells(Rows.Count, "A").End(xlUp))
        'On va se decaler pour aller voir la valeur de la colonne K
        StrFeuil = CelTest.Offset(0, 10).Value
        'On evite un plantage sur une cellule qui serait vide
        If StrFeuil <> "" Then
            'On controle que ca n'est pas la 1er entrée que l'on fait dans le tableau
            'Je fait ca a cause des 2 lignes qui sont presente dans ton tableau et qui laissent donc 2 case vide dans la colonne A
            'Cases qui ne doivent bien sur pas etre prisent en compte.
            If Sheets(StrFeuil).Cells(Rows.Count, "A").End(xlUp).Row = 5 Then
                'On est dans le cas d'une 1ere saisi
                'On va donc effectuer la copy 2 lignes plus bas
                'On copy la ligne dans l'onglet correspondant
                'CelTest.EntireRow.Copy Sheets(StrFeuil).Cells(Rows.Count, "A").End(xlUp).Offset(2, 0)
                'On peut ne copier que les cellules qui contiennent les valeurs necessaires (de A à J)
                .Range(CelTest, CelTest.Offset(0, 9)).Copy Sheets(StrFeuil).Cells(Rows.Count, "A").End(xlUp).Offset(3, 0)
            Else
                'On copy la ligne dans l'onglet correspondant, a la suite des lignes deja saisies
                'CelTest.EntireRow.Copy Sheets(StrFeuil).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                'On peut ne copier que les cellules qui contiennent les valeurs necessaires (de A à J)
                .Range(CelTest, CelTest.Offset(0, 9)).Copy Sheets(StrFeuil).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
 
            End If
        End If
    Next
End With
 
End Sub

A++
Qwaz

[frisette68]

Merci pour tout je pense avoir compris ta macro même si ce n'est pas évident....

En tout cas elle me convient parfaitement.

A +