Bonjour à tous,
J'ai un fichier correspondant à une liste de client, avec les informations les concernant. L'une des colonnes contenant la date du rendez-vous avec le client.
Je souhaiterait séparer ce fichier, et créer un nouveau fichier pour chaque date, qui regroupe toutes les lignes des clients ayant rendez-vous à cette date.
J'ai réussi à créer des nouveaux onglets avec ce fonctionnement mais je préfèrerais créer des nouveaux fichiers.
J'arrive à créer les fichiers, mais je ne parviens pas à rajouter les nouvelles lignes à un fichier déjà créé, cela me propose sans cesse de créer un nouveau fichier qui écrase le précédent.
Est-ce mieux si j'upload aussi mon fichier?
Merci d'avance,
Jaden
J'ai un fichier correspondant à une liste de client, avec les informations les concernant. L'une des colonnes contenant la date du rendez-vous avec le client.
Je souhaiterait séparer ce fichier, et créer un nouveau fichier pour chaque date, qui regroupe toutes les lignes des clients ayant rendez-vous à cette date.
J'ai réussi à créer des nouveaux onglets avec ce fonctionnement mais je préfèrerais créer des nouveaux fichiers.
J'arrive à créer les fichiers, mais je ne parviens pas à rajouter les nouvelles lignes à un fichier déjà créé, cela me propose sans cesse de créer un nouveau fichier qui écrase le précédent.
VB:
Sub ParseItems()
'Based on selected column, data is filtered to individual workbooks
'workbooks are named for the value plus today's date
Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
Dim ws As Worksheet, MyArr As Variant, vTitles As String, SvPath As String
Dim contenu As String
'Sheet with data in it
Set ws = Sheets("export_intervention_client")
'Path to save files into, remember the final \
SvPath = "\"
'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
vTitles = "A1:BH1"
'Choose column to evaluate from, column A = 1, B = 2, etc.
' vCol = Application.InputBox("What column to split data by? " & vbLf _
' & vbLf & "(A=1, B=2, C=3, etc)", "Which column?", 1, Type:=1)
' If vCol = 0 Then Exit Sub
vCol = 31
'Spot bottom row of data
LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row
'Speed up macro execution
Application.ScreenUpdating = False
'Get a temporary list of unique values from key column
ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True
'Sort the temporary list
ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'Put list into an array for looping (values cannot be the result of formulas, must be constants)
MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))
'clear temporary worksheet list
ws.Range("EE:EE").Clear
'Turn on the autofilter, one column only is all that is needed
ws.Range(vTitles).AutoFilter
'Loop through list one value at a time
For Itm = 2 To UBound(MyArr)
ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)
ws.Range("A1:A" & LR).EntireRow.Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
Cells.Columns.AutoFit
MyCount = MyCount + Range("AE" & Rows.Count).End(xlUp).Row - 1
contenu = ws.Cells(Itm, 31).Value
'ActiveWorkbook.SaveAs SvPath & MyArr(Itm) & Format(Date, "ddmmyyyy"), xlNormal
'ActiveWorkbook.SaveAs SvPath & MyArr(Itm) & Format(Date, "ddmmyyyy") & ".xlsx", 51
ActiveWorkbook.SaveAs Filename:=Format(contenu, "dd-mm-yyyy") & " Export planning" 'use for Excel 2007+
ActiveWorkbook.Close
ws.Range(vTitles).AutoFilter Field:=vCol
Next Itm
'Cleanup
ws.AutoFilterMode = False
MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
End SubEst-ce mieux si j'upload aussi mon fichier?
Merci d'avance,
Jaden
Dernière édition:
