Discussion :

[Freudsw]

Bonjour à tous,

je suis novice en vba et j'aimerais créer une macro qui me permettrait de copier des lignes d'un tableau vers differents onglets du même classeurs selon les valeurs qui se trouvent dans une colonne du tableau.

sachant que dans cette colonne se trouve trois valeurs (Europe, Asie et US), et il y a trois onglet qui s'apellent eux aussi (Europe, Asie et US). en gros j'aimerais copier toutes les lignes correspendantes a chaque regions dans l'onglet qui lui est attribué.

vous pouvez me donner au moins une idée comment commencer mon code.

Je vous remercie.

Cordialement,
Freudsw

[joe.levrai]

Bonjour,

une piste :

1) filtre automatique : filtre de la colonne contenant le continent
2) pour chaque continent filtré :on obtient les lignes qui s'y rapportent
3) on recopie les valeur dans le bon onglet (nom onglet = valeur du continent)

je t'invite à reproduire cette procédure à la main, en utilisant l'enregistreur de macro
tu auras un début de code qu'il faudra adapter et nettoyer (notamment pour créer les boucles qui s'appliqueront sur chaque ligne de la plage filtrée)

revient avec ce code si tu n'arrives pas à le modifier, afin qu'on t'aide

[Freudsw]

Bonjour Joe,

Merci pour votre réponse, j'ai déja pensé à faire ça, le code m'a l'aire de marcher, mais est ce qu'il y a moyen de l'ameliorer ?
Ci dessous le code qui est sortie avec l'enregistreur de macro aprés éliminations des superflux.

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 transfertzone()
 Columns("R:R").Select
    Selection.AutoFilter
    ActiveSheet.Range("$R$1:$R$435").AutoFilter Field:=1, Criteria1:="Europe"
    Range("A1:R158").Select
    Selection.Copy
    Sheets("Europe").Select
    Range("A10").Select
    ActiveSheet.Paste
    Sheets("Raw Data").Select
    ActiveSheet.Range("$R$1:$R$435").AutoFilter Field:=1, Criteria1:="US"
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("US").Select
    Range("A10").Select
    ActiveSheet.Paste
    Sheets("Raw Data").Select
    ActiveSheet.Range("$R$1:$R$435").AutoFilter Field:=1, Criteria1:="Asie"
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Asie").Select
    Range("F10").Select
    Range("A10").Select
    ActiveSheet.Paste
    Sheets("Raw Data").Select
    ActiveSheet.Range("$R$1:$R$435").AutoFilter Field:=1
End Sub

Merci

[MarcelG]

Bonjour à vous, Bonjour au Forum

(mes excuses pour cette absence prolongée)

L'enregistreur est bien utile, mais il faut le dominer.
Il convient donc de lui ôter tout caractère redondant.

A commencer par ces f... "Select" qui sont tout à fait inutiles.

Comme le code doit effectuer la même fonction 3 fois, tu peux effectuer une boucle sur une variable "Array".
D'autant, que l'onglet destinataire et le filtre sont de la même occurence.

Reviens si nécessaire.

J'oubliais "Bienvenu sur le Forum."

[pasdechances]

Conseil d'amis évite d'utiliser l'enregistreur de macro.
Autan excel se connais très bien, autan toi tu ne connais pas assez excel, pour jouer avec son auto-programmation et la comprendre.
Cela dit, sa ne t'enpeche pas de faire comme la si bien dit joe.levrai.
Cela dit je peut te donner un chemain (plus long mais plus facil à comprendre)a suivre concernant la programmation.
Voici le chemin :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
While cells(ligne,colonne) <> ""
 
    if toncritere = cells(ligne,colonne) then
 
        Acopier(x)  = cells(ligne,colone)
        x = x + 1
 
    end if
 
    ligne = ligne + 1
 
wend

ainsi tu as un la variable tableau "Acopier" qui enregistre le contenu a copier.
il ne te restera plus qu'a utliser la même boucle, mais en sens inverse celon et tes envies pour ecrire dans les celules de ton choix.

On est ici pour apprendre, le tout cuit ne mène à rien, courage =).

[MarcelG]

Salut,

2 indications

1 - Pour utiliser la méthode filtre

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
Option Explicit
 
Public Sub copy_filtre()
 
Dim finfiltr As Long
Dim pays As Variant
 
Application.ScreenUpdating = False
 
With Worksheets(1)
    'enlève le tri éventuel
    If .FilterMode = True Then .ShowAllData
    'définit la dernière ligne des données
    finfiltr = .Cells(.Rows.Count, 2).End(xlUp).Row
    For Each pays In Array("US", "France", "Allemagne")
        'active le filtre
        .Range("$A$1:$B$" & finfiltr).AutoFilter Field:=2, Criteria1:=pays
        'copie des cellules correspondant au critère
        .Range("$A$1:$B$" & finfiltr).SpecialCells(xlCellTypeVisible).Copy Worksheets(pays).Range("A1")
        'désactive le filtre
        .ShowAllData
    Next pays
End With
 
End Sub

2 - Quand tu seras familiarisé avec les notions de dictionnaires, collections et varaibles tableau, tu pourras lire cette contribution d'un modeste contributeur

alimentation onglets depuis synthèse

[joe.levrai]

Voici un peu de ménage dans le code, j'ai mis quelques commentaires pour ta compréhension :

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
35
36
Sub transfertzone()
Dim Tablo()
 
' un tableau pour stocker les continents
' (pour réaliser une boucle)
Tablo = Array("Europe", "US", "Asie")
 
With ThisWorkbook.Worksheets("Raw Data")
 
    ' si les filtres automatiques sont en place, on affiche toutes les données
    If .AutoFilterMode Then .ShowAllData
 
    ' pour chaque valeur du Tableau des continents
    For i = LBound(Tablo) To UBound(Tablo)
        ' on filtre la colonne R avec le nom du continent
        With .Range("A1")
            .AutoFilter
            .AutoFilter 18, Tablo(i)
        End With
 
        ' la plage utilisée dans ta feuille
        With .UsedRange
 
            ' si en appliquant le filtre, il y a au moins 2 cellules visibles en colonne R
            ' ça veut dire qu'on a au moins une ligne de résultat
            ' (sinon, on a juste la cellule du titre de colonne)
            If .Columns(18).SpecialCells(xlCellTypeVisible).Count > 1 Then
                ' on copie la plage (avec les titres) vers la feuille qui porte le nom du continent
                ' (la copie s'effectue à partir de la ligne 10)
                .SpecialCells(xlCellTypeVisible).Copy ThisWorkbook.Worksheets(Tablo(i)).Range("A10")
            End If
        End With
    Next i
End With
 
End Sub

La copie est réalisée à partir de la ligne 10 de chaque feuille de destination, comme c'était le cas dans ton code (la copie ramène également la ligne 1 qui doit contenir tes en-têtes de colonnes)


S'il faut adapter des choses, comme :

- calculer dynamiquement la ligne où les données doivent êtres copiées
- ne pas inclure les titres de tes colonnes
- prévoir des tests d'existence des feuilles
- prévoir des messages d'avertissement s'il n'y a pas de données
- etc....


n'hésite pas à nous préciser ce que tu souhaites


EDIT : y'a du monde sur le fil, je me suis fais griller sur ce coup là (ça m'apprendra à trainer au restaurant )

[Freudsw]

Re-bonjour à tous,

le code fonctionne parfaitement bien, et je vous remercie de m'avoir eclairé. ce qui est sur c'est que j'ai beacoups de choses à apprendre, et je crois que je suis sur le bon forum pour cela

Pour un peu corser les choses, dans mon tableau, la premiere colonne correspond à des dates allant du 1 au 31 du mois (selon le mois), j'aimerais au moment de copier les données dans chaque onglet, ne pas copier ou bien supprimer les lignes qui correspendent à la derniere date.
genre si mon tableau va du 1 au 30, je ne veux pas copier les lignes qui correspondent au 30.

Voila, je vous remercie encore.

Voici le code que j'ai pris en compte

c'est celui de joe, j'ai juste ajouté une ligne vers la fin pour supprimer le filtre

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
Sub transfertzone()
Dim Tablo()
 
' un tableau pour stocker les continents
' (pour réaliser une boucle)
Tablo = Array("Europe", "US", "Asie")
 
With ThisWorkbook.Worksheets("Raw Data")
    ' si les filtres automatiques sont en place, on affiche toutes les données
    If .FilterMode = True Then .ShowAllData
    ' pour chaque valeur du Tableau des continents
    For i = LBound(Tablo) To UBound(Tablo)
        ' on filtre la colonne R avec le nom du continent
        With .Range("A1")
            .AutoFilter
            .AutoFilter 18, Tablo(i)
        End With
        ' la plage utilisée dans ta feuille
        With .UsedRange
            ' si en appliquant le filtre, il y a au moins 2 cellules visibles en colonne R
            ' ça veut dire qu'on a au moins une ligne de résultat
            ' (sinon, on a juste la cellule du titre de colonne)
            If .Columns(18).SpecialCells(xlCellTypeVisible).Count > 1 Then
                ' on copie la plage (avec les titres) vers la feuille qui porte le nom du continent
                ' (la copie s'effectue à partir de la ligne 10)
                .SpecialCells(xlCellTypeVisible).Copy ThisWorkbook.Worksheets(Tablo(i)).Range("A10")
            End If
        End With
    Next i
    .ShowAllData
End With
End Sub