Bonjour à tous,
je calle sur une macro et m'en remets donc à vous
Ma macro splitte un fichier excel en plusieurs fichiers excel sur base d'une colonne determinée.
J'aimerais pouvoir récupérer ma mise en forme, mes filtres mais surtout la data validation que j'ai faite sur certaines cellules.
Voici ma macro qui fonctionne mais sans récuperer la data validation
Sub GenerateCSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
iCol = 4 '### Define your criteria column
strOutputFolder = "C:\test" '### Define your path of output folder
Set ws = ThisWorkbook.ActiveSheet '### Don't edit below this line
Set rngLast = Columns(iCol).Find("*", Cells(1, iCol), , , xlByColumns, xlPrevious)
ws.Columns(iCol).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rngUnique = Range(Cells(2, iCol), rngLast).SpecialCells(xlCellTypeVisible)
If Dir(strOutputFolder, vbDirectory) = vbNullString Then MkDir strOutputFolder
For Each strItem In rngUnique
If strItem <> "" Then
ws.UsedRange.AutoFilter Field:=iCol, Criteria1:=strItem.Value
Workbooks.Add
ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=[A1]
strFilename = strOutputFolder & "\" & strItem
ActiveWorkbook.SaveAs Filename:=strFilename, FileFormat:=51
ActiveWorkbook.Close savechanges:=False
End If
Next
ws.ShowAllData
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Un tout grand merci pour votre aide
je calle sur une macro et m'en remets donc à vous
Ma macro splitte un fichier excel en plusieurs fichiers excel sur base d'une colonne determinée.
J'aimerais pouvoir récupérer ma mise en forme, mes filtres mais surtout la data validation que j'ai faite sur certaines cellules.
Voici ma macro qui fonctionne mais sans récuperer la data validation
Sub GenerateCSV()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
iCol = 4 '### Define your criteria column
strOutputFolder = "C:\test" '### Define your path of output folder
Set ws = ThisWorkbook.ActiveSheet '### Don't edit below this line
Set rngLast = Columns(iCol).Find("*", Cells(1, iCol), , , xlByColumns, xlPrevious)
ws.Columns(iCol).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rngUnique = Range(Cells(2, iCol), rngLast).SpecialCells(xlCellTypeVisible)
If Dir(strOutputFolder, vbDirectory) = vbNullString Then MkDir strOutputFolder
For Each strItem In rngUnique
If strItem <> "" Then
ws.UsedRange.AutoFilter Field:=iCol, Criteria1:=strItem.Value
Workbooks.Add
ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=[A1]
strFilename = strOutputFolder & "\" & strItem
ActiveWorkbook.SaveAs Filename:=strFilename, FileFormat:=51
ActiveWorkbook.Close savechanges:=False
End If
Next
ws.ShowAllData
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Un tout grand merci pour votre aide