[Débutant] Créer un nouveau classeur à partir d'une ligne d'un tableau

**GuyXL** · 30/06/2011, 14h55

A priori donc le code est bien dans un module standard. Je ne vois pas pourquoi l'erreur survient, ormis si elle ne survient qu'en faisant le code pas à pas et en activant manuellement le classeur d'origine alors qu'on vient d'ouvrir un nouveau classeur qui est censé être l'actif à ce moment là.

D'ou un nouveau code ou tous les objets sont désignés (les 2 classeurs, les deux feuilles). Les noms de Sh1, Sh2, Wb2, Ch1, Ch2 sont à adapter. Cordialement

R

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
Option Explicit
 
Sub test()
Dim Sh1 As Worksheet, Sh2 As Worksheet, Wb1 As Workbook, Wb2 As Workbook, Ch1$, Ch2$, i&, j%
    'chemin vers le doossier client à adapter
    Ch1 = "C:\Clients\"
    'nom complet classeur matrice à adapter
    Ch2 = "C:\Matrice prévisions clients internet.xls"
    'déclaration classeur et feuille données client
    Set Wb1 = ThisWorkbook
    Set Sh1 = Wb1.Worksheets("Feuil1")
    'pour chaque ligne de la feuille données client
    For i = 2 To Sh1.Cells(Rows.Count, 1).End(xlUp).Row
        'si le classeur portant le nom du client n'existe pas à l'endroit spécifié
        If Dir(Ch1 & Sh1.Cells(i, 1) & ".xlsm") <> "" = False Then
            Workbooks.Open Ch2 'ouvrir le classeur matrice
            Set Wb2 = Workbooks("Matrice prévisions clients internet.xls")
            Set Sh2 = Wb2.Worksheets("prévisions en cours")
            'remplir les informations dans le classeur matrice
            Sh2.Cells(2, 2) = Sh1.Cells(i, 1)
            Sh2.Cells(3, 2) = Sh1.Cells(i, 3)
            Sh2.Cells(5, 2) = Sh1.Cells(i, 24)
            Sh2.Cells(6, 3) = Sh1.Cells(i, 7)
            'sauvegarder le classeur matrice sous le nom du client
            ActiveWorkbook.SaveAs Ch1 & Sh1.Cells(i, 1) & ".xlsm", FileFormat:=52
            'pour xls ActiveWorkbook.SaveAs Ch1 & w.Cells(i, 1) & ".xls", FileFormat:=56
            'pour xlsx : ActiveWorkbook.SaveAs Ch1 & w.Cells(i, 1) & ".xlsx", FileFormat:=51
            'fermer le classeur créé
            ActiveWorkbook.Close
        End If
    Next i
End Sub

**DerJul** · 30/06/2011, 15h07

ça maaaaaaaaaaaaaaaaaaaaaaaaaaarche MERCI ^^

Autre petite question est-il possible de faire autrement qu'en associant la macro avec un bouton sur lequel on appuie après chaque "maj" du fichier clients ?

Par ailleurs il est possible que le collaborateur ou l'adresse change au cours du temps est-ce possible de faire en sorte que la macro vérifie que les données soient bien toujours les mêmes entre la liste clients et les données de la feuille de prévision et si <> alors reprendre les données de la liste clients ?

J'ai essayé de faire quelque chose mais 1) j'ai un message d'erreur " next sans for " et 2) je ne suis pas convaincu que ça puisse fonctionner ainsi :

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
Sub test2()
Dim Sh1 As Worksheet, Sh2 As Worksheet, Wb1 As Workbook, Wb2 As Workbook, Ch1$, Ch2$, i&, j%
    'chemin vers le doossier client à adapter
    Ch1 = "C:\Users\DerJul\Desktop\Stage L3\internet\clients\mission comptable\"
    'nom complet classeur matrice à adapter
    Ch2 = "C:\Users\DerJul\Desktop\Stage L3\internet\Matrice prévisions clients internet.xls"
    'déclaration classeur et feuille données client
    Set Wb1 = ThisWorkbook
    Set Sh1 = Wb1.Worksheets("Feuil1")
    'pour chaque ligne de la feuille données client
    For i = 2 To Sh1.Cells(Rows.Count, 1).End(xlUp).Row
        'si le classeur portant le nom du client n'existe pas à l'endroit spécifié
        If Dir(Ch1 & Sh1.Cells(i, 1) & ".xlsm") <> "" = True Then
             Workbooks.Open Ch2 'ouvrir le classeur matrice
             Set Wb2 = Workbooks("Matrice prévisions clients internet.xls")
            Set Sh2 = Wb2.Worksheets("prévisions en cours")
            If Sh2.Cells(2, 2) <> Sh1.Cells(i, 1) Then Sh2.Cells(2, 2) = Sh1.Cells(i, 1)
            If Sh2.Cells(3, 2) <> Sh1.Cells(i, 3) Then Sh2.Cells(3, 2) = Sh1.Cells(i, 3)
            If Sh2.Cells(5, 2) <> Sh1.Cells(i, 24) Then Sh2.Cells(5, 2) = Sh1.Cells(i, 24)
            If Sh2.Cells(6, 3) <> Sh1.Cells(i, 7) Then Sh2.Cells(6, 3) = Sh1.Cells(i, 7)
 
        If Dir(Ch1 & Sh1.Cells(i, 1) & ".xlsm") <> "" = False Then
            Workbooks.Open Ch2 'ouvrir le classeur matrice
            Set Wb2 = Workbooks("Matrice prévisions clients internet.xls")
            Set Sh2 = Wb2.Worksheets("prévisions en cours")
            'remplir les informations dans le classeur matrice
            Sh2.Cells(2, 2) = Sh1.Cells(i, 1)
            Sh2.Cells(3, 2) = Sh1.Cells(i, 3)
            Sh2.Cells(5, 2) = Sh1.Cells(i, 24)
            Sh2.Cells(6, 3) = Sh1.Cells(i, 7)
            'sauvegarder le classeur matrice sous le nom du client
            ActiveWorkbook.SaveAs Ch1 & Sh1.Cells(i, 1) & ".xlsm", FileFormat:=52
            'pour xls ActiveWorkbook.SaveAs Ch1 & w.Cells(i, 1) & ".xls", FileFormat:=56
            'pour xlsx : ActiveWorkbook.SaveAs Ch1 & w.Cells(i, 1) & ".xlsx", FileFormat:=51
            'fermer le classeur créé
            ActiveWorkbook.Close
        End If
    Next i
End Sub

**GuyXL** · 30/06/2011, 15h26

Envoyé par DerJul

Autre petite question est-il possible de faire autrement qu'en associant la macro avec un bouton sur lequel on appuie après chaque "maj" du fichier clients ?

Ben on peur faire plein de choses... Que veux tu faire ?

Envoyé par DerJul

Par ailleurs il est possible que le collaborateur ou l'adresse change au cours du temps est-ce possible de faire en sorte que la macro vérifie que les données soient bien toujours les mêmes entre la liste clients et les données de la feuille de prévision et si <> alors reprendre les données de la liste clients ?

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
Option Explicit
 
Sub test()
Dim Sh1 As Worksheet, Sh2 As Worksheet, Wb1 As Workbook, Wb2 As Workbook, Ch1$, Ch2$, i&, j%, b%
    'chemin vers le doossier client à adapter
    Ch1 = "C:\Clients\"
    'nom complet classeur matrice à adapter
    Ch2 = "C:\Matrice prévisions clients internet.xls"
    'déclaration classeur et feuille données client
    Set Wb1 = ThisWorkbook
    Set Sh1 = Wb1.Worksheets("Feuil1")
    'pour chaque ligne de la feuille données client
    For i = 2 To Sh1.Cells(Rows.Count, 1).End(xlUp).Row
        'si le classeur portant le nom du client n'existe pas à l'endroit spécifié
        If Dir(Ch1 & Sh1.Cells(i, 1) & ".xlsm") <> "" = False Then
            Workbooks.Open Ch2 'ouvrir le classeur matrice
            Set Wb2 = Workbooks("Matrice prévisions clients internet.xls")
            Set Sh2 = Wb2.Worksheets("prévisions en cours")
            'remplir les informations dans le classeur matrice
            Sh2.Cells(2, 2) = Sh1.Cells(i, 1)
            Sh2.Cells(3, 2) = Sh1.Cells(i, 3)
            Sh2.Cells(5, 2) = Sh1.Cells(i, 24)
            Sh2.Cells(6, 3) = Sh1.Cells(i, 7)
            'sauvegarder le classeur matrice sous le nom du client
            Wb2.SaveAs Ch1 & Sh1.Cells(i, 1) & ".xlsm", FileFormat:=52
            'pour xls ActiveWorkbook.SaveAs Ch1 & w.Cells(i, 1) & ".xls", FileFormat:=56
            'pour xlsx : ActiveWorkbook.SaveAs Ch1 & w.Cells(i, 1) & ".xlsx", FileFormat:=51
        Else 'sinon
            Workbooks.Open Ch1 & Sh1.Cells(i, 1) & ".xlsm" 'ouvrir le classeur client
            Set Wb2 = Workbooks(Sh1.Cells(i, 1) & ".xlsm")
            Set Sh2 = Wb2.Worksheets("prévisions en cours")
            'vérifier les infos et actualiser si nécessaire
            If Sh2.Cells(2, 2) <> Sh1.Cells(i, 1) Then
                Sh2.Cells(2, 2) = Sh1.Cells(i, 1)
                b = True
            End If
            If Sh2.Cells(3, 2) <> Sh1.Cells(i, 3) Then
                Sh2.Cells(3, 2) = Sh1.Cells(i, 3)
                b = True
            End If
            If Sh2.Cells(5, 2) <> Sh1.Cells(i, 24) Then
                Sh2.Cells(5, 2) = Sh1.Cells(i, 24)
                b = True
            End If
            If Sh2.Cells(6, 3) <> Sh1.Cells(i, 7) Then
                Sh2.Cells(6, 3) = Sh1.Cells(i, 7)
                b = True
            End If
            'sauvegarder si au moins une modif
            If b Then Wb2.Save
        End If
        'fermer le classeur créé ou modifié
        Wb2.Close
    Next i
End Sub

Cordialement

R

**DerJul** · 30/06/2011, 15h51

En fait je me rends compte que cela ne va pas être pratique/possible sans bouton pour actionner la macro puisque à la bsa je voulais que cela se fasse tout seul sans intervention de notre part mais je me rends compte qu'il faut déterminer un instant à partir du quel la macro pourrait se déclencher et je ne vois pas quand. A moins d'automatiser la création d'une fiche juste en insérant le nom. Mais ensuite va-t-elle prendre en compte les autres données ? Et puis cela risque de faire tourner la macro sans arrêt et de faire apparaître et disparaitre toutes les fiches clients sans arrêt cela ne sera pas pratique.

Je pense que je vais donc rester sur mon bouton

Encore merci

Je viens de me rendre compte que je devais aussi remplir un autre fichier à partir de la liste clients. Je vais essayer d'adapter ta macro. Je lancerai un autre topic d'ici peu pour finir de boucler la boucle ( il va falloir maintenant que je récupère les données créées dans la fiche de prévision pour les mettre dans une fiche de synthèse ). J'éditerai le lien ici.

ENCORE MERCI

Bon finalement je n'arrive pas à arranger le code pour remplir mon autre tableau en même temps

. Voilà sur quoi j'étais parti :

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Option Explicit
 
Sub test3()
Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet, Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook, Ch1$, Ch2$, Ch3$, i&, j%, b%
    'chemin vers le doossier client à adapter
    Ch1 = "C:\Users\DerJul\Desktop\Stage L3\internet\clients\mission comptable\"
    'nom complet classeur matrice à adapter
    Ch2 = "C:\Users\DerJul\Desktop\Stage L3\internet\Matrice prévisions clients internet.xls"
    'déclaration classeur et feuille données client
    Ch3 = "C:\Users\DerJul\Desktop\Stage L3\Nouvel essai\Temps prévisionnel.xls"
    Set Wb1 = ThisWorkbook
    Set Sh1 = Wb1.Worksheets("Feuil1")
    'pour chaque ligne de la feuille données client
    For i = 2 To Sh1.Cells(Rows.Count, 1).End(xlUp).Row
        'si le classeur portant le nom du client n'existe pas à l'endroit spécifié
        If Dir(Ch1 & Sh1.Cells(i, 1) & ".xlsm") <> "" = False Then
            Workbooks.Open Ch2 'ouvrir le classeur matrice
            Set Wb2 = Workbooks("Matrice prévisions clients internet.xls")
            Set Sh2 = Wb2.Worksheets("prévisions en cours")
            'remplir les informations dans le classeur matrice
            Sh2.Cells(2, 2) = Sh1.Cells(i, 1)
            Sh2.Cells(3, 2) = Sh1.Cells(i, 3)
            Sh2.Cells(5, 2) = Sh1.Cells(i, 24)
            Sh2.Cells(6, 3) = Sh1.Cells(i, 7)
            'sauvegarder le classeur matrice sous le nom du client
            Wb2.SaveAs Ch1 & Sh1.Cells(i, 1) & ".xlsm", FileFormat:=52
            'pour xls ActiveWorkbook.SaveAs Ch1 & w.Cells(i, 1) & ".xls", FileFormat:=56
            'pour xlsx : ActiveWorkbook.SaveAs Ch1 & w.Cells(i, 1) & ".xlsx", FileFormat:=51
        Else 'sinon
            Workbooks.Open Ch1 & Sh1.Cells(i, 1) & ".xlsm" 'ouvrir le classeur client
            Set Wb2 = Workbooks(Sh1.Cells(i, 1) & ".xlsm")
            Set Sh2 = Wb2.Worksheets("prévisions en cours")
            'vérifier les infos et actualiser si nécessaire
            If Sh2.Cells(2, 2) <> Sh1.Cells(i, 1) Then
                Sh2.Cells(2, 2) = Sh1.Cells(i, 1)
                b = True
            End If
            If Sh2.Cells(3, 2) <> Sh1.Cells(i, 3) Then
                Sh2.Cells(3, 2) = Sh1.Cells(i, 3)
                b = True
            End If
            If Sh2.Cells(5, 2) <> Sh1.Cells(i, 24) Then
                Sh2.Cells(5, 2) = Sh1.Cells(i, 24)
                b = True
            End If
            If Sh2.Cells(6, 3) <> Sh1.Cells(i, 7) Then
                Sh2.Cells(6, 3) = Sh1.Cells(i, 7)
                b = True
            End If
            'sauvegarder si au moins une modif
            If b Then Wb2.Save
        End If
        'fermer le classeur créé ou modifié
        Wb2.Close
      Next i
    
        For i = 2 To Sh1.Cells(Rows.Count, 1).End(xlUp).Row
        Workbooks.Open Ch3
        Set Wb3 = Workbooks("Temps prévisionnel.xls")
        Set Sh3 = Wb3.Worksheets("Feuil1")
        Next i
        i = j
        For j = 3 To Sh3.Cells(Rows.Count, 1).End(xlUp).Row
            Sh3.Cells(j, 1) = Sh1.Cells(i, 1)
            Sh3.Cells(j, 2) = Sh1.Cells(i, 2)
            Sh3.Cells(j, 3) = Sh1.Cells(i, 3)
            Sh3.Cells(j, 5) = Sh1.Cells(i, 5)
            Sh3.Cells(j, 6) = Sh1.Cells(i, 7)
            Sh3.Cells(j, 8) = Sh1.Cells(i, 4)
            
            Wb3.Save
            Wb3.Close
           
        Next j
    
End Sub

Je joins également le fichier en question pour mieux comprendre. Pouvez-vous encore m'aider ?

**GuyXL** · 30/06/2011, 16h42

Envoyé par DerJul

En fait je me rends compte que cela ne va pas être pratique/possible sans bouton pour actionner la macro puisque à la bsa je voulais que cela se fasse tout seul sans intervention de notre part mais je me rends compte qu'il faut déterminer un instant à partir du quel la macro pourrait se déclencher et je ne vois pas quand.

Juste avant la fermeture du classeur source ? Faire une recherche sur :
Private Sub Workbook_BeforeClose

Cordialement

R

**DerJul** · 01/07/2011, 10h12

Bonjour,

Après réflexion, je cherche le moyen de lancer la macro pour créer des fichiers inexistants et mettre à jour uniquement pour les lignes de clients qui ont changé.

J'ai fais quelques recherches et je voudrai savoir s'il est possible d'avoir une macro qui le fasse. Je me disais qu'il existait peut-être un moyen d'afficher une valeur (0 ou 1) dans une colonne à la fin de mon tableau de ma liste clients ou la valeur 1 apparaitrait pour chaque modification de ligne et qu'ainsi la macro mettrait à jour uniquement les lignes où la case serait remplie avec un 1.

Je ne sais pas si c'est très clair ? N'hésitez pas à me demander des éclaircissements.

Merci de votre aide

**GuyXL** · 01/07/2011, 14h51

Bonjour DerJul,

Ca me semble une bonne idée :

Rajouter donc un intitulé de colonne en colonne Y

Les lignes suivantes de la macro Test (je me base sur la dernière version que j'ai postée) sont modifiées comme suit :

Code :

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

Sub test()

->

Code :

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

Sub test(i&)

Supprimer le , i& dans la ligne suivante :

Code :

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

Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet, Wb1 As Workbook, Wb2 As Workbook, Wb3 As Workbook, Ch1$, Ch2$, Ch3$, i&, j%, b%

Supprimer les 2 lignes :

Code :

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

1
2
3
For i = 2 To Sh1.Cells(Rows.Count, 1).End(xlUp).Row
...
next i

Dan le module ThisWorkbook :

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
Option Explicit
 
Private Sub Workbook_Open()
Dim w1 As Worksheet, Rw&, Cl%
    Set w1 = Worksheets("Feuil1")
    Rw = w1.Cells(Rows.Count, 1).End(xlUp).Row
    Cl = w1.Cells(1, Columns.Count).End(xlToLeft).Column
    w1.Range(w1.Cells(2, Cl), w1.Cells(Rw, Cl)) = 0
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim w1 As Worksheet, Rw&, Cl%, i&
    Set w1 = Worksheets("Feuil1")
    Rw = w1.Cells(Rows.Count, 1).End(xlUp).Row
    Cl = w1.Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 2 To Rw
        If w1.Cells(i, Cl) = 1 Then Call test(i)
    Next i
End Sub

La première sub remplie la dernière colonne de 0 à l'ouverture du classeur. La seconde appelle la Sub Test pour chaque ligne ou la nouvelle colonne vaut 1 lors de la fermeture du classseur.

Dans le module de la Feuil1

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cl%, c As Range
    Cl = Cells(1, Columns.Count).End(xlToLeft).Column
    For Each c In Target
        If c.Row > 1 And c.Column < Cl And Cells(c.Row, 1) <> "" Then
            Cells(c.Row, Cl) = 1
        End If
    Next c
End Sub

A chaque modification d'une ligne du tableau, la dernière colonne prends la valeur 1.

Cordialement R

**DerJul** · 01/07/2011, 14h58

Je vais essayer de suite

Merci pour tous le temps que vous passez à m'aider,

Cordialement,

DerJul

La macro fonctionne bien pour 0 à l'ouverture et 1 si changement

Mais au moment de fermer pour que la macro se lance, j'ai un message d'erreur qui surligne le Call test du "Then Call test (i)" de la 2è sub du workbook. J'ai essayé de mettre test (i&) comme dans la macro mais cela ne fonctionne pas non plus, que dois-je faire ?

Edit : le message d'erreur est :

Erreur de compilation :
Nombre d'arguments incorrect ou affectation de propriété incorrecte

**GuyXL** · 01/07/2011, 16h24

Re,

Pourriez vous postez les code actuel ? Cordialement R

**DerJul** · 04/07/2011, 09h11

Bonjour,

Voilà le code que j'ai rentré dans la matrice d'après ce que vous m'avez dis. J'espère avoir tout mis là où il le fallait :

Dans le code de la Feuil1 :

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
63
64
65
Option Explicit
 
Sub test(i&)
Dim Sh1 As Worksheet, Sh2 As Worksheet, Wb1 As Workbook, Wb2 As Workbook, Ch1$, Ch2$, j%, b%
    'chemin vers le doossier client à adapter
    Ch1 = "C:\Users\DerJul\Desktop\Stage L3\internet\clients\mission comptable\"
    'nom complet classeur matrice à adapter
    Ch2 = "C:\Users\DerJul\Desktop\Stage L3\internet\Matrice prévisions clients internet.xls"
    'déclaration classeur et feuille données client
    Set Wb1 = ThisWorkbook
    Set Sh1 = Wb1.Worksheets("Feuil1")
    'pour chaque ligne de la feuille données client
            'si le classeur portant le nom du client n'existe pas à l'endroit spécifié
        If Dir(Ch1 & Sh1.Cells(i, 1) & ".xlsm") <> "" = False Then
            Workbooks.Open Ch2 'ouvrir le classeur matrice
            Set Wb2 = Workbooks("Matrice prévisions clients internet.xls")
            Set Sh2 = Wb2.Worksheets("prévisions en cours")
            'remplir les informations dans le classeur matrice
            Sh2.Cells(2, 2) = Sh1.Cells(i, 1)
            Sh2.Cells(3, 2) = Sh1.Cells(i, 3)
            Sh2.Cells(5, 2) = Sh1.Cells(i, 24)
            Sh2.Cells(6, 3) = Sh1.Cells(i, 7)
            'sauvegarder le classeur matrice sous le nom du client
            Wb2.SaveAs Ch1 & Sh1.Cells(i, 1) & ".xlsm", FileFormat:=52
            'pour xls ActiveWorkbook.SaveAs Ch1 & w.Cells(i, 1) & ".xls", FileFormat:=56
            'pour xlsx : ActiveWorkbook.SaveAs Ch1 & w.Cells(i, 1) & ".xlsx", FileFormat:=51
        Else 'sinon
            Workbooks.Open Ch1 & Sh1.Cells(i, 1) & ".xlsm" 'ouvrir le classeur client
            Set Wb2 = Workbooks(Sh1.Cells(i, 1) & ".xlsm")
            Set Sh2 = Wb2.Worksheets("prévisions en cours")
            'vérifier les infos et actualiser si nécessaire
            If Sh2.Cells(2, 2) <> Sh1.Cells(i, 1) Then
                Sh2.Cells(2, 2) = Sh1.Cells(i, 1)
                b = True
            End If
            If Sh2.Cells(3, 2) <> Sh1.Cells(i, 3) Then
                Sh2.Cells(3, 2) = Sh1.Cells(i, 3)
                b = True
            End If
            If Sh2.Cells(5, 2) <> Sh1.Cells(i, 24) Then
                Sh2.Cells(5, 2) = Sh1.Cells(i, 24)
                b = True
            End If
            If Sh2.Cells(6, 3) <> Sh1.Cells(i, 7) Then
                Sh2.Cells(6, 3) = Sh1.Cells(i, 7)
                b = True
            End If
            'sauvegarder si au moins une modif
            If b Then Wb2.Save
        End If
        'fermer le classeur créé ou modifié
        Wb2.Close
    End Sub
 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cl%, c As Range
    Cl = Cells(1, Columns.Count).End(xlToLeft).Column
    For Each c In Target
        If c.Row > 1 And c.Column < Cl And Cells(c.Row, 1) <> "" Then
            Cells(c.Row, Cl) = 1
        End If
    Next c
End Sub

Et dans le code de "ThisWorkbook" :

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
Option Explicit
 
Private Sub Workbook_Open()
Dim w1 As Worksheet, Rw&, Cl%
    Set w1 = Worksheets("Feuil1")
    Rw = w1.Cells(Rows.Count, 1).End(xlUp).Row
    Cl = w1.Cells(1, Columns.Count).End(xlToLeft).Column
    w1.Range(w1.Cells(2, Cl), w1.Cells(Rw, Cl)) = 0
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim w1 As Worksheet, Rw&, Cl%, i&
    Set w1 = Worksheets("Feuil1")
    Rw = w1.Cells(Rows.Count, 1).End(xlUp).Row
    Cl = w1.Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 2 To Rw
        If w1.Cells(i, Cl) = 1 Then Call test(i&)
    Next i
End Sub

Voilà,

Merci à vous

**GuyXL** · 04/07/2011, 14h17

Bonjour DerJules,

Dans Private Sub Workbook_BeforeClose(Cancel As Boolean)
c'est
If w1.Cells(i, Cl) = 1 Then Call test(i)
et pas
If w1.Cells(i, Cl) = 1 Then Call test(i&)

ps : & dans Sub test(i&) indique que i est un long, c'est l'équivalent de Sub test(i as long). Il n'a pas à être présent lors de l'appel de la Sub Test

Pas une erreur mais j'aurais tendance à mettre la Sub test(i&) dans un module standard.

Cordialement

KD

**DerJul** · 04/07/2011, 14h53

Bonjour,

En combinant vos 2 remarques cela fonctionne !!
Finalement j'ai mis le code de test (i) dans un module standard et changé (i&) en (i) pour le call test

UN GRAND MERCI

Topic Résolu

J'aurai grand besoin de vos lumières pour la suite

Edit : lien du nouveau topic :
http://www.developpez.net/forums/d11...u/#post6103331

[Débutant] Créer un nouveau classeur à partir d'une ligne d'un tableau [XL-2007]

Macros et VBA Excel

Discussions similaires

Partager

Partager