copier une ligne dans une autre feuille en fonction d'une valeur

[crucho]

bonjour,
debutant en excell je ne trouve pas de fonction pouvant faire ceci.
j'ai une feuille avec une liste de client. et je souhaiterait trier ceux si sur des feuilles distincte. je souhaiterai que tout les client carrefour ce trouve sur la feuille carrefour, cora sur la feuille cora et ainsi de suite.
donc en fonction de la valeur de la colonne C de la feuille 'Liste site internet' toute la ligne soit copier sur la page respective.

un tout grand merci d'avance

Crucho

 

[Hieu]

Re : copier une ligne dans une autre feuille en fonction d'une valeur

Salut,

Une petite macro, pour réaliser le collage de toutes tes valeurs, en fonction du magasin.

Sub mlkm()
For Each c In Sheets("Liste site internet").Range("c:c")
Select Case c
    Case "Carrefour Market"
        For j = 0 To 5
        Sheets(c.Value).Range("a13").Offset(i_cm, j) = c.Offset(0, j)
        Next j
        i_cm = i_cm + 1
    Case "CORA"
        For j = 0 To 5
        Sheets(c.Value).Range("a13").Offset(i_cora, j) = c.Offset(0, j)
        Next j
        i_cora = i_cora + 1
    Case "Delitraiteur"
        For j = 0 To 5
        Sheets(c.Value).Range("a13").Offset(i_deli, j) = c.Offset(0, j)
        Next j
        i_deli = i_deli + 1
    Case "Intermarché"
        For j = 0 To 5
        Sheets(c.Value).Range("a13").Offset(i_inter, j) = c.Offset(0, j)
        Next j
        i_inter = i_inter + 1
    Case "Match"
        For j = 0 To 5
        Sheets(c.Value).Range("a13").Offset(i_deli, j) = c.Offset(0, j)
        Next j
        i_match = i_match + 1
    Case "Hyper Carrefour"
        For j = 0 To 5
        Sheets(c.Value).Range("a13").Offset(i_hc, j) = c.Offset(0, j)
        Next j
        i_hc = i_hc + 1
End Select
Next c
End Sub

++

 

[thebenoit59]

Re : copier une ligne dans une autre feuille en fonction d'une valeur

Bonjour Crucho. Bonjour Hieu.

Une solution différente de celle proposée par Hieu.
L'objectif étant de mettre sous tableau la liste et d'extraire les lignes correspondants à chaque onglet avec un index.
En même temps, une vérification de l'existence de l'onglet est mise en place pour éviter les erreurs.

Option Explicit
Option Base 1

'Forumeur : crucho
'Auteur : TheBenoit59
'Lien : [URL]https://www.excel-downloads.com/threads/copier-une-ligne-dans-une-autre-feuille-en-fonction-dune-valeur.20008774/[/URL]

Sub Dispatching()
Dim Liste, a, c
Dim i As Integer
Dim d As Object: Set d = CreateObject("scripting.dictionary")
Dim t

'On enregistre la liste sous forme de tableau
With Sheets("Liste site internet")
    Liste = .Range("c6:f" & .[c65000].End(xlUp).Row)
End With

'On crée un index des lignes de chaque magasin
For i = LBound(Liste) To UBound(Liste)
    d(Liste(i, 1)) = d(Liste(i, 1)) & i & ":"
Next i

'On boucle l'index pour répartir dans les différents onglets
For Each c In d.keys
    'Depuis l'index ou crée un tableau selon le magasin
    a = Application.Index(Liste, Application.Transpose(Split(d(c), ":")), Array(1, 2, 3, 4))
    'On vérifie que l'onglet du magasin existe
    If FeuilleExiste(c) Is Nothing Then
    'Si elle n'existe pas nous la créons avec le modèle de la troisième feuille
    'On place la feuille en avant-dernière position
    Sheets(3).Copy Before:=Sheets(Sheets.Count)
    ActiveSheet.Name = c
    'On modifie les informations de la feuille pour qu'elles soient conformes
    With Sheets(c)
        .[a1] = "Statistique " & c
        .[a3] = "Nombre total de " & c
    End With
    'On quitte la fonction If, sans Else, car dans tous les cas nous passons à la suite
    End If
    'On se place dans l'onglet du magasin
    With Sheets(c)
        'On définit la dernière ligne utilisée
        i = .[a65000].End(xlUp).Row + 1
        'On vide les informations existantes (évite les mauvaises manipulations)
        .Range("a12:d" & i).ClearContents
        'On importe le tableau du magasin en question
        .Cells(12, 1).Resize(UBound(a) - 1, 4).Value = a
    End With
'On relance la boucle
Next c
End Sub

Function FeuilleExiste(f As Variant) As Worksheet
'Fonction personnalisée de Pierrot93
'Pour vérifier l'existence d'une feuille
On Error Resume Next
Set FeuilleExiste = Worksheets(f)
End Function