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