Discussion :

[Geoffray69]

Bonjour a tous,

J'ai cherche un peu sur le forum mais je n'ai pas trouvé de solution à mon problème qui est le suivant.

Je dispose d'un fichier "Master" qui contient toutes sortes de données dont notamment tous les articles de mon ERP. Pour chaque ligne, j'ai le fournisseur associé.

Je souhaite automatiser la tâche suivante :
-Pour chaque fournisseur (Je dispose de la liste) :
-copier les lignes des articles qu'ils me fournit et les copier dans un autre fichier que j'ai pré-edité (meme dimension etc...) et enfin l'enregistrer au nom du fournisseur et le mettre dans un fichier specifié.

Voila le code que j'ai tente de faire ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
36
37
38
39
40
41
42
43
44
45
46
Private Sub CommandButton4_Click()
 
 
Dim Nom1 As String
Dim Nom2 As String
Dim Nom3 As String
Dim i As Long
Dim max1 As Long
Dim max2 As Long
'j'ouvre les deux classeur
 
 
Nom1 = ThisWorkbook.Name 'Fichier1.xls
 
Call Ouvre
Nom2 = ActiveWorkbook.Name ' fichier2.xls qui contient la liste des fournisseurs
 
Windows(Nom2).Activate
 
max2 = Range("E65536").End(xlUp).Row
 
For i = 1 To max2
 
fournisseur = Workbooks(Nom2).Worksheets("Master Extraction").Range("G" & i).Value
 
Workbooks(Nom2).Worksheets("Master Extraction").Range("$A$3:$BD$37066").AutoFilter Field:=26, Criteria1:=fournisseur
Rows("1:300").Select
Selection.Copy
Workbooks.Add
Nom3 = ActiveWorkbook.Name
Windows(Nom3).Activate
Workbooks(Nom2).Worksheets("Master Extraction").Range("A1").Select
Workbooks(Nom2).Worksheets("Master Extraction").Paste
 
' Sauvegarde du document
With ActiveDocument
    .SaveAs "C:\Users\gmellet\Documents\" & fournisseur & ".xls"
    .Close
End With
 
 
Next i
Application.ScreenUpdating = True
 
 
End Sub

Merci d'avance de votre aide !

[jijie]

Je ne sais pas trop ce que tu souhaite faire, mais pour ouvrir un fichier il faut faire comme ceci par exemple:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Dim wb As Workbook
Dim ws As Worksheet
Set wb = Workbooks.Open("C:\Documents and Settings\---------------\Mes documents\aaaaa.xls")
Set ws = wb.Worksheets(1)

[jijie]

vite fait mais il reste encore du travail!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
36
37
38
39
40
41
42
43
44
45
46
47
Private Sub CommandButton4_Click()
 
 
      Dim Nom1 As String
      Dim Nom2 As String
      Dim Nom3 As String
      Dim i As Long
      Dim max1 As Long
      Dim max2 As Long
 
10    Application.ScreenUpdating = False 'désactive la mise à jour de l'écran
 
      'j'ouvre le classeurs suivant ton chemin à modifier ou le nommer par une variable!
 
20    Set Wkb1 = ThisWorkbook ' le classeur actuel
30    Set Wkb2 = Workbooks.Open("C:\Documents and Settings\---------------\Mes documents\adresse.xlsx")
 
40    Wkb2.Activate
 
50    max2 = Range("E65536").End(xlUp).Row
 
60    For i = 1 To max2
 
70    fournisseur = Wkb2.Sheets("Master Extraction").Range("G" & i).Value
 
80    Wkb2.Sheets("Master Extraction").Range("$A$3:$BD$37066").AutoFilter Field:=26, Criteria1:=fournisseur
90    Rows("1:300").Select
100   Selection.Copy
110   Set Wkb3 = Workbooks.Add 'créér un nouveau classeur
120   Wkb3.Activate
130   Wkb3.Sheets("feuil1").Name = "Master Extraction" ' je pense que tu souhaite nommer la feuille ainsi?
 
      'Workbooks(Nom2).Worksheets("Master Extraction").Range("A1").Select 'pourquoi nom2 si tu active le 3
      'Workbooks(Nom2).Worksheets("Master Extraction").Paste
140   Wkb3.Sheets("Master Extraction").Range("a1").Paste
      ' Sauvegarde du document
150   With Wkb3
160       .SaveAs "C:\Users\gmellet\Documents\" & fournisseur & ".xls"
170       .Close
180   End With
 
 
190   Next i
200   Application.ScreenUpdating = True
 
 
End Sub

Je ne sais pas si j'ai bien compris !

je doute ds ton exemple entre le classeur 2 et le 3 ds les lignes de ton code 30,31,32...

de plus à chaque tour du " i " si tu rencontre plusieurs fois le même fournisseur tu vas enregistrer autant de fichiers identique du même fournisseur
et là tu vas planter!

Donc 2ème solution :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Private Sub CommandButton4_Click()
 
 
Dim Nom1 As String
Dim Nom2 As String
Dim Nom3 As String
Dim i As Long
Dim max1 As Long
Dim max2 As Long
 
Application.ScreenUpdating = False 'désactive la mise à jour de l'écran
 
'j'ouvre les trois classeurs
 
Set Wkb1 = ThisWorkbook ' le classeur actuel
Set Wkb2 = Workbooks.Open("C:\Documents and Settings\---------------\Mes documents\adresse.xlsx")
 
Wkb2.Activate
 
max2 = Range("E65536").End(xlUp).Row
 
' ** on cherche les fournisseurs ds la colonne "g" sans doublons
Set Dico = CreateObject("Scripting.Dictionary")
 
    For Each c In Wkb2.Sheets("Master Extraction").Range("g2:g" & max2)   ' colonne g! début en g2 si titre
      'on teste si la valeur de la cellule n'est pas déjà dans le dictionnaire
      'sinon on créer cette valeur comme nouvelle clé et comme nouvel item
      If Not Dico.Exists(c.Value) Then Dico.Add c.Value, c.Offset(0, 0).Value
    Next c
 
 n = Dico.items
 
For i = 1 To Dico.Count - 1 ' donc--> i=1 to le nbre de fourniseur identique
 
fournisseur = n(i) 'ici on retrouve une seule fois le fournisseur
 
 
Wkb2.Sheets("Master Extraction").Range("$A$3:$BD$37066").AutoFilter Field:=26, Criteria1:=fournisseur
Rows("1:300").Select
Selection.Copy
Set Wkb3 = Workbooks.Add 'créér un nouveau classeur
Wkb3.Activate
Wkb3.Sheets("feuil1").Name = "Master Extraction" ' je pense que tu souhaite nommer la feuille ainsi?
 
'Workbooks(Nom2).Worksheets("Master Extraction").Range("A1").Select 'pourquoi nom2 si tu active le 3
'Workbooks(Nom2).Worksheets("Master Extraction").Paste
Wkb3.Sheets("Master Extraction").Range("a1").Paste
 
     ' Sauvegarde du document
With Wkb3
    .SaveAs "C:\Users\gmellet\Documents\" & fournisseur & ".xls"
    .Close
End With
 
 
Next i
 
 
 
End Sub

Bon attention ce n'est pas testé

[Geoffray69]

Salut !

Merci beaucoup pour ton aide !

J'ai adapté un peu et tout semble marcher jusqu’à la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Wkb3.Worksheets("Master Extraction").Range("A1").Paste

Elle me renvoie une erreur 438 :propriété ou méthode non gérée par cet objet

Merci d'avance de m'éclairer et encore merci pour ta précédente réponse !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Private Sub CommandButton5_Click()
 
Dim Nom1 As String
Dim Nom2 As String
Dim Nom3 As String
Dim i As Long
Dim max1 As Long
Dim max2 As Long
 
Application.ScreenUpdating = False 'désactive la mise à jour de l'écran
 
'j'ouvre les trois classeurs
 
Set Wkb1 = ThisWorkbook ' le classeur actuel
Set Wkb2 = Workbooks.Open("C:\Users\gmellet\Desktop\Fournisseur.xlsx")
 
Wkb2.Activate
 
max2 = Range("A65536").End(xlUp).Row
 
' ** on cherche les fournisseurs ds la colonne "g" sans doublons
Set Dico = CreateObject("Scripting.Dictionary")
 
    For Each c In Wkb2.Sheets("Feuil1").Range("A1:A" & max2)   ' colonne g! début en g2 si titre
      'on teste si la valeur de la cellule n'est pas déjà dans le dictionnaire
      'sinon on créer cette valeur comme nouvelle clé et comme nouvel item
      If Not Dico.Exists(c.Value) Then Dico.Add c.Value, c.Offset(0, 0).Value
    Next c
 
 n = Dico.items
 
For i = 1 To Dico.Count - 1 ' donc--> i=1 to le nbre de fourniseur identique
 
fournisseur = n(i) 'ici on retrouve une seule fois le fournisseur
 
Wkb1.Activate
Wkb1.Sheets("Master Extraction").Range("$A$3:$BD$37066").AutoFilter Field:=26, Criteria1:=fournisseur
Wkb1.Sheets("Master Extraction").Range("$A$3:$BD$37066").AutoFilter Field:=36, Criteria1:=Array( _
        "ACTIF", "INACTIF", "SUSPENDU")
 
Rows("1:300").Copy
 
Set Wkb3 = Workbooks.Add 'créér un nouveau classeur
Wkb3.Activate
Wkb3.Sheets("Feuil1").Name = "Master Extraction" ' je pense que tu souhaite nommer la feuille ainsi?
 
'Workbooks(Nom2).Worksheets("Master Extraction").Range("A1").Select 'pourquoi nom2 si tu active le 3
'Workbooks(Nom2).Worksheets("Master Extraction").Paste
Wkb3.Worksheets("Master Extraction").Range("A1").Paste
 
     ' Sauvegarde du document
With Wkb3
    .SaveAs "C:\Users\gmellet\Documents\" & fournisseur & ".xls"
    .Close
End With
 
 
Next i
 
 
 
End Sub

[jijie]

envoi une feuille pour tester!!

[Geoffray69]

Voila !

[clementmarcotte]

Bonjour,

Salut !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Wkb3.Worksheets("Master Extraction").Range("A1").Paste

C'est de mémoire et non testé, mais il me semble que tu affrontes un des rares cas où tu dois sélectionner la cellule avant de l'utiliser.

Essaie avec:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Wkb3.Worksheets("Master Extraction").Range("A1").select
selection.paste

[Geoffray69]

J'ai essayé mais toujours rien...