Notes

Sub Split_by_Client_and_Price()

Dim nombre_client, index_parcours_client As Integer
Dim range_dynamic As Range
Dim nom_parcours_client As Variant
Dim cellule_client, cellule_extraction, save_path, name_file_date, name_file_start, name_file_end, full_save_path, titre_global, titre_prix As String
Dim sheet_source_client, sheet_matrice_tarif As Worksheet


''''''''''''''''''''''''''''''''''''''
'Variable à modifier selon le besoin''
''''''''''''''''''''''''''''''''''''''

'Définition de la feuille qui contient la liste des clients en valeurs unique
Set sheet_source_client = Worksheets("SOURCE_ Clients")
'Définition de la feuille et de la colonne qui contient la liste des clients (la valeur client doit être unique dans la colonne)
Set column_extraction = sheet_source_client.Range("E:E")
'Définition de la cellule qui contient le nom du client
cell_client = "E"
'Définition de la cellule qui contient oui ou non pour l'extraction de chaque client
cell_extraction = "D"


'Définition de la feuille qui contient la matrice des tarifs
Set sheet_matrice_tarif = Worksheets("MATRICE_TARIF")
date_process = Format(Now, "dd-mm-yyyyy hh-mm-ss")
'Definition du chemin d'enregistrement du fichier
save_path = "C:UsersSossoDesktopExtraction " & date_process & ""
'Definition du nom du fichier d'enregistrement
name_file_date = "JANV 2024"
name_file_start = "AQUALABO-"
name_file_end = " LOOS_TARIFS LABORATOIRE_" & name_file_date & ".xlsx"



'Définition des propriété de formatage
titre_global = "AQUALABO - TARIFS GAMME LABORATOIRE"
titre_prix = "VOTRE PRIX en € HT"
''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''


'Création du dossier d'extraction
MsgBox save_path
MkDir (save_path)

'On stocke dans la variable nombre_client le nombre de client de la colonne qui contient la liste des clients de la feuille excel SOURCE_ Clients
nombre_client = Application.WorksheetFunction.CountA(column_extraction)


'On indique le nombre de client en message box qui fait aussi office de pause dans la macro vba
If nombre_client > 0 Then
MsgBox "La colonne des clients contient " & nombre_client & " clients."
Else
MsgBox "La colonne des clients est vide."
End If



'Préparation d'une bloucle while qu'on éxécute jusqu'au nombre maximum de client (variable nombre_client)
index_parcours_client = 2
While index_parcours_client < nombre_client

index_parcours_client = index_parcours_client + 1
'On sélectionne le nom du client dans la colonne
nom_parcours_client = sheet_source_client.Range(cell_client & index_parcours_client).Value

'On teste la valeur d'extraction (oui ou non) associé à chaque client (association via le numéro de ligne)
If sheet_source_client.Range(cell_extraction & index_parcours_client).Value = "OUI" Then

'Si la valeur est égale à "OUI" on éxécute le code client
sheet_matrice_tarif.Activate
ActiveSheet.Range("$A$1:$T$43").AutoFilter Field:=3, Criteria1:=nom_parcours_client


'Le code suivant peut être améliorer, ici on sélectionne une plage de colonne à la suite et on colle dans un nouveau fichier
'le mieux lors d'une amélioration serait de coller colonne par colonne
Columns("E:G").Select
Selection.Copy
Workbooks.Add
Range("A4").Select
ActiveSheet.Paste
Application.CutCopyMode = False


'Formatage du fichier

'Cellule Titre Général
Range("A1:C1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
Range("A1:C1").Select
ActiveCell.FormulaR1C1 = "" & titre_global & ""
Range("A1:C1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
End With
Selection.Font.Bold = True

'Cellule Nom du client
Range("B2").Select
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "" & nom_parcours_client & ""

'Cellule Date de traitement
Range("C2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "" & name_file_date & ""


'Colonne des prix

'Cellule Titre
'Application d'un formatage
Range("C4").Select
ActiveCell.FormulaR1C1 = "" & titre_prix & ""
With Selection.Interior
.Pattern = xlSolid
.PatternThemeColor = xlThemeColorAccent1
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.599993896298105
.PatternTintAndShade = 0
End With
With Selection.Font
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
End With
Range("D4").Select
Columns("C:C").ColumnWidth = 11.27

'Valeurs la colonne des prix
'On récupère le numéro de dernière cellule avec un nombre dans la colonne C
iColumn = Columns("C").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
'Application d'un formatage
Range("C5:C" & iColumn & "").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent6
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
Selection.Font.Bold = False

Columns("C:C").Select
Range("C2").Activate
Selection.NumberFormat = "0.00"


'On règle la taille des cellules pour la feuille entière
Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit


'Enregistrement et fermeture du fichier spécifique à un client
'Creation de la variable finale pour le chemin d'enregistrement
full_save_path = "" & save_path & name_file_start & nom_parcours_client & name_file_end & ""
ActiveWorkbook.SaveAs Filename:=full_save_path, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close



Else
'Si la valeur est différente de "OUI" on ne fait rien pour ce client
End If

Wend

End Sub