Vich
XLDnaute Nouveau
Bonjour à tous,
Encore une fois j'ai besoin de vous pour mon stage =).
Voilà le problème qui se pose :
Lorsque j'appel ma macro elle créer 54 nouveaux fichier Excel dans le répertoire ou se trouve le fichier Excel de base (celui qui est divisé en 54 partie). Mes consignes sont que la macro doit demander où sauvegarder les nouveaux fichiers.
Il faut donc une windows form avec un explorateur de fichier, et d'après ce que j'ai recherché, ce n'est pas si simple à mettre en oeuvre.
Voici la macro qui créer les fichiers :
Merci d'avance pour votre aide toujours aussi précieuse =).
Encore une fois j'ai besoin de vous pour mon stage =).
Voilà le problème qui se pose :
Lorsque j'appel ma macro elle créer 54 nouveaux fichier Excel dans le répertoire ou se trouve le fichier Excel de base (celui qui est divisé en 54 partie). Mes consignes sont que la macro doit demander où sauvegarder les nouveaux fichiers.
Il faut donc une windows form avec un explorateur de fichier, et d'après ce que j'ai recherché, ce n'est pas si simple à mettre en oeuvre.
Voici la macro qui créer les fichiers :
Code:
Sub TriICD()
Dim MonDico As Object
Dim i As Integer, NbLg As Long, J As Long
Dim Chemin As String
Dim Tablo
Application.ScreenUpdating = False
Chemin = ThisWorkbook.Path & Application.PathSeparator
With Sheets("ICD")
If .FilterMode = True Then .ShowAllData
.Range("AE1") = .Range("B1") ' Prépares l'entête de la zone critère
NbLg = .Range("B" & Rows.Count).End(xlUp).Row
Set MonDico = CreateObject("Scripting.dictionary")
For J = 2 To NbLg
MonDico(.Range("B" & J).Value) = ""
Next J
Tablo = MonDico.keys
If Sheets.Count <> 3 Then
Sheets.Add(after:=Sheets(1)).Name = "Feuil1"
Sheets.Add(after:=Sheets(1)).Name = "Feuil2"
End If
For i = 0 To UBound(Tablo)
.Range("AE2") = Tablo(i)
.Range("A1:AB" & NbLg).AdvancedFilter Action:=xlFilterCopy, criteriarange:=.Range("AE1:AE2"), copytorange:=Sheets("Feuil2").Range("A1:AB1")
Sheets("Feuil2").DrawingObjects.Delete
Sheets("Feuil2").Copy
With ActiveWorkbook
.Sheets(1).Name = Tablo(i)
Call ExportationToron
.SaveAs Chemin & Tablo(i) & ".xlsx"
.Close
End With
Next i
.Range("AE1:AE2").ClearContents
End With
Sheets("Feuil2").Cells.Clear
MsgBox "Création des " & MonDico.Count & " fichiers terminée"
End Sub
Merci d'avance pour votre aide toujours aussi précieuse =).
Dernière édition: