Enregistrer sous et supprimer une partie du code
Bonjour à tous,
J'ai fait un fichier dont le but est
1. lister des personnes : j'ai userform1 qui contient entre autres choses une listbox1. Cette listbox1 est alimentée au fil du temps.
2. sauvegarder une copie de ce fichier pour chaque personne listée dans la listbox1, en enlevant la partie du code et notamment l'userform1.
Voici mon code actuel :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
|
Private Sub BtCréerFichier_Click()
Dim i As Integer
Dim fich As String, dep As String
Dim Cel As Range
Dim Depart As Long
Dim FName As String
Dim VBComp
Application.ScreenUpdating = False
FName = BrowseFolder("Select A Folder")
If Dir(FName, vbDirectory) <> vbNullString Then
For i = 0 To Listbox1.ListCount - 1
Set Cel = Sheets(1).Columns("B").Find(what:=Me.Listbox1.List(i, 0), LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
Depart = Cel.Row
Sheets(1).Range("C" & Depart).Value = Sheets(1).Range("C" & Depart).Value + 1
dep = Sheets(1).Range("D" & Depart).Value
End If
fich = Me.Listbox1.List(i, 0) & " (" & dep & ")"
Sheets(3).Range("B1").Value = Me.Listbox1.List(i, 0)
Sheets(3).Range("B2").Value = dep
ActiveWorkbook.SaveCopyAs Filename:=FName & fich
Set VBComp = ThisWorkbook.VBProject.VBComponents("Userform1")
ActiveWorkbook.VBProject.VBComponents.Remove VBComp
ActiveWorkbook.Save
ActiveWorkbook.Close
Set Cel = Nothing
Application.EnableEvents = True
Next i
Listbox1.Clear
End If
Application.ScreenUpdating = True
End Sub |
Evidemment, ce code ne fonctionne pas comme je le souhaiterais... Pouvez-nous me donner un petit coup de main svp ?
Merci de votre indulgence,
Amicalement
