[vba Excel] mise à jour de tableau

Version imprimable

24/05/2007, 15h02
ancel17

[vba Excel] mise à jour de tableau

Bonjour !

j'ai un fichier Excel avec plusieurs feuilles (sommaire, sous-rubrique1,...sous-rubriquen).
Dans toutes mes feuilles "sous-rubrique", j'ai un tableau dont la structure ne varie pas.

je voudrais savoir comment récupérer automatiquement les lignes des tableaux de toutes les feuilles "sous-rubrique" et les insérer au tableau de la feuille "sommaire".

Merci de vos réponses !

Tu as deux solutions, ou tu copies 'plage de données' par 'plage de données' dans ta feuille sommaire.
Ou tu copies tes plages ligne par ligne
Pour la solution par plage, tu peux tester ça
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Sub RassemblerLesFeuillesDunClasseurDansUneSeule() Dim CL1 As Workbook Dim FL1 As Worksheet, LaFeuille as Worksheet Set CL1 = Workbooks("Liste pour fusion.xls") Set FL1 = CL1.Worksheets("Sommaire") For Each LaFeuille In CL1.Worksheets If Not LaFeuille.Name = FL1.Name Then _ LaFeuille.Range("A2:" & LaFeuille.Range("A1"). _ SpecialCells(xlCellTypeLastCell).Address).Copy _ Destination:=FL1.Range("A" & FL1.Range("A1"). _ SpecialCells(xlCellTypeLastCell).Row + 1) Next Set FL1 = Nothing Set CL1 = Nothing End Sub
A+

Edit
Je fais commencer la copie en A2 (LaFeuille.Range("A2:"...) afin de ne pas copier l'entête éventuelle des feuilles copiées
Si pas d'entête -> LaFeuille.Range("A1:" ...

NB - Avant copie, ton fichier doit être enregistré pour que
Range("A1").SpecialCells(xlCellTypeLastCell)
donne l'exact N° de dernière cellule de la plage de données à copier
ou le N° de la première cellule vide où coller

Merci pour ton aide !

voici le code actuel :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Private Sub Worksheet_Activate() Dim CL1 As Workbook Dim FL1 As Worksheet, LaFeuille As Worksheet Set CL1 = Workbooks("Air.xls") Set FL1 = CL1.Worksheets("Sommaire") With FL1.Rows("15:65536") .ClearContents .Delete End With For Each LaFeuille In CL1.Worksheets If Not LaFeuille.Name = FL1.Name Then _ LaFeuille.Range("A15:" & LaFeuille.Range("A1"). _ SpecialCells(xlCellTypeLastCell).Address).Copy _ Destination:=FL1.Range("A" & FL1.Range("A1"). _ SpecialCells(xlCellTypeLastCell).Row + 1) Next Set FL1 = Nothing Set CL1 = Nothing End Sub
j'ai inséré un bloc with car je souhaite que mon tableau de la feuille "sommaire" soit recalculé à chaque fois que la feuille est affichée. J'ai donc essayé .ClearContents, puis .Delete, puis les deux pour essayer de résoudre mon problème qui est le suivant :

les données importées des autres feuilles du classeur sont copiées à la suite du tableau précédent (bien que les lignes du tableau soient préalablement supprimées)

j'obtiens donc un tableau avec n lignes vides correspondant aux lignes des données précédentes et m lignes correctement remplies correspondant aux lignes des nouvelles données.

Vois-tu où est le problème ?

Désolé pour le dérangement, j'ai trouvé la solution que j'avais déjà dans ta première réponse...
j'ai juste un peu zappé ton NB et du coup, je n'enregistrais pas mon fichier avant de copier mes données.

Voici le code qui fonctionne :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 Private Sub Worksheet_Activate() Dim CL1 As Workbook Dim FL1 As Worksheet, LaFeuille As Worksheet Set CL1 = Workbooks("Air.xls") Set FL1 = CL1.Worksheets("Sommaire") FL1.Rows("15:65536").Delete CL1.Save For Each LaFeuille In CL1.Worksheets If Not LaFeuille.Name = FL1.Name Then _ LaFeuille.Range("A15:" & LaFeuille.Range("A1"). _ SpecialCells(xlCellTypeLastCell).Address).Copy _ Destination:=FL1.Range("A" & FL1.Range("A1"). _ SpecialCells(xlCellTypeLastCell).Row + 1) Next Set FL1 = Nothing Set CL1 = Nothing End Sub
Toujours dans le meme style mais en un peu plus compliqué, je voudrais maintenant importer les données de mes tableaux "sommaire" (j'ai plusieurs fichiers .xls différents) dans un tableau situé dans un autre classeur.

Comment faire ?

Ou tu veux lister les fichiers d'un répertoire particulier, ou tu connais les noms et chemins des fichiers à "agglutiner", auquel cas tu en fais un tableau.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 LeTableau = Array("D:\xls\Sommaire1.xls", "D:\xls\Sommaire2.xls", "D:\xls\Sommaire3.xls", "D:\xls\Sommaire4.xls") 'le classeur contenant la macro et dans lequel tu colles les feuilles sommaire Set Fl1 = ThisWorkbook 'La boucle For i = 1 to Ubound(LeTableau) Set FL2 = Workbooks.open LeTableau(i) 'Copie de la feuille FL1. 'collage DoEvents FL2.close false Next
et là tu dois pouvoir adapter à ton nouveau fichier le code qui t'a servi pour créer le sommaire.
A+

Tout d'abord merci pour tes réponses !

Voici le code que j'ai inséré dans le classeur qui reçoit les données :

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
36
37
38
Private Sub Worksheet_Activate()
 
Dim fso As New FileSystemObject
Dim fich As file
Dim Rep As Folder
Dim Wk As Variant
Dim TabFich() As String
    Set Rep = fso.GetFolder(Application.ThisWorkbook.Path & "\Thèmes")
    For Each fich In Rep.Files
        Wk = Chemin & fich.Name
         'Renseigne une listbox
        If fso.GetExtensionName(Wk) = "xls" Then _
           listbox1.AddItem Wk
        End If
    Next
    Set Rep = Nothing
 
Dim CL1 As Workbook, CL2 As Workbook
Dim FL1 As Worksheet, FL2 As Worksheet
    Set CL1 = ThisWorkbook
    Set FL1 = CL1.Worksheets("Sommaire")
    FL1.Rows("74:65536").Delete
    CL1.Save
    For i = 1 To UBound(listbox1)
        Set CL2 = Workbooks.Open(listbox1(i))
        Set FL2 = CL2.Worksheets("sommaire")
        FL2.Range("A15:" & FL2.Range("A1"). _
        SpecialCells(xlCellTypeLastCell).Address).Copy _
        Destination:=FL1.Range("A" & FL1.Range("A1"). _
        SpecialCells(xlCellTypeLastCell).Row + 1)
    Next i
 
    Set FL1 = Nothing
    Set CL1 = Nothing
    Set FL2 = Nothing
    Set CL2 = Nothing
 
End Sub

Je ne sais pas si cela peut fonctionner étant donné que j'ai une erreur dès la première ligne :

Code:

Dim fso As New FileSystemObject

L'erreur est la suivante :

Citation:

Erreur de compilation :
Type défini par l'utilisateur non défini

Qu'en penses-tu ?

29/05/2007, 15h52
ouskel'n'or

Oui, tu dois valider la référence la reference "Microsoft Scripting RunTime" -> Editeur VB -> Outils -> Références.
Dis-moi où tu as pris le code que j'ajoute ce renseignement ;)
A+

Edit
Fais attention, ce code ajoute le nom de fichier à une liste.
Tu supprimes la ligne " listbox1.AddItem Wk" que tu remplaces par Ouverture Wk -> Sélectionner tout -> copier/coller... enfin, bref, le code qui va bien.
En l'occurence, à la place de FL2, tu utilises Wk puis qu'il existe dans le code.
A+

PS - là où tu as pris le code, c'est écrit "Ce code nécessite la validation de la référence "Microsoft Scripting RunTime". Non mais ! :mouarf:
29/05/2007, 16h11
ancel17

j'ai pris ce code ici

je vais voir si je parviens à faire ce qu'il faut pour que ça fonctionne.
En tout cas c'est bon de se sentir soutenu !

Voila, maintenant le code fonctionne correctement, et le voici :

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
36
37
Private Sub Worksheet_Activate()
 
Dim fso As New FileSystemObject
Dim fich As file
Dim Rep As Folder
Dim Wk As Variant
Dim TabFich() As String
Dim CL1 As Workbook, CL2 As Workbook
Dim FL1 As Worksheet, FL2 As Worksheet
 
    Set CL1 = ThisWorkbook
    Set FL1 = CL1.Worksheets("Sommaire")
    Set Rep = fso.GetFolder(Application.ThisWorkbook.Path & "\Thèmes")
 
            FL1.Rows("74:65536").Delete
 
            For Each fich In Rep.Files
                Wk = Rep & "\" & fich.Name
                If fso.GetExtensionName(Wk) = "xls" Then
                    CL1.Save
                    Set CL2 = Workbooks.Open(Wk)
                    Set FL2 = CL2.Worksheets("sommaire")
                        FL2.Range("A15:" & FL2.Range("A1"). _
                        SpecialCells(xlCellTypeLastCell).Address).Copy _
                        Destination:=FL1.Range("B" & FL1.Range("B1"). _
                        SpecialCells(xlCellTypeLastCell).Row + 1)
                        CL2.Close
                End If
            Next
 
    Set Rep = Nothing
    Set FL1 = Nothing
    Set CL1 = Nothing
    Set FL2 = Nothing
    Set CL2 = Nothing
 
End Sub

J'ai juste encore un petit souci : j'aimerai que le tableau soit recalculé à chaque fois que la feuille est affichée (si je navigue d'un fichier xls à un autre, lorsque je reviens sur le fichier avec le tableau, le fichier n'est pas mis à jour).
Pour voir le code fonctionner, j'ai du insérer une deuxième feuille au classeur pour faire la bascule...

Autre question, est-il possible de ne pas voir à l'écran l'ouverture et la fermeture de chaque fichier ?

Et enfin la dernière... pour l'instant : comment pour chaque ligne collée, affecter à la première colonne le nom du fichier d'origine ?

29/05/2007, 19h37
ouskel'n'or
Citation:

j'aimerai que le tableau soit recalculé à chaque fois que la feuille est affichée (si je navigue d'un fichier xls à un autre, lorsque je reviens sur le fichier avec le tableau, le fichier n'est pas mis à jour).

Code:

Application.Calculate

Mais regarde à Calculate, dans l'aide, elle t'en dit plus et tu pourras mettre ce qui te convient le mieux.

Citation:

Autre question, est-il possible de ne pas voir à l'écran l'ouverture et la fermeture de chaque fichier ?

Il y a une solution mais en cas de bug, elle est (très) risquée. En voici une que tu peux tester, après la ligne
Code:

1 2 Set CL2 = Workbooks.Open(Wk) CL2.visible = False
Code:

Et enfin la dernière... pour l'instant : comment pour chaque ligne collée, affecter à la première colonne le nom du fichier d'origine ?

Là, je dis "Ouf !"
Si tu avais copié tes feuilles ligne par ligne c'eut été plus long mais aussi plus simple.
Une proposition en l'état : Consiste à tester la colonne en question.
On part de la première feuille copiée. Pour remplir ta colonne du nom du fichier, tu cherches la dernière ligne renseignée de ta (nouvelle) plage de données et tu places Wk sur toutes les cellules de la colonne jusqu'à dernière ligne.
Code:

1 2 3 4 5 PremLign = 1 'ou 2 si tu as un en-tête Derlig = Range("A1").SpecialCells(xlCellTypeLastCell).Row For i = PremLign to Derlig Cells(i, NoCol).value = WK Next
Tu peux aussi ne le coller qu'une fois et recopier vers le bas jusqu'à la fin de ta plage.
Pour la seconde feuille copiée et les suivantes, tu pars de la première cellule vide

Code:

PremLig = Range("A65535").End(xlUp).Row + 1

(code que tu peux utiliser pour la première feuille collée, à la réflexion...) tu pars donc de la première cellule vide à la nouvelle dernière ligne de ta plage

Code:

Range("A1").SpecialCells(xlCellTypeLastCell).Row

Tu dois insérer ce code apès collage de la feuille dans sommaire
N'oublie pas d'indiquer la bonne feuille (FL1.Range("A65535").End.....) ;)
A+

Edit
Tout bien corrigé, ça donnerait ça
Code:

1 2 3 4 5 PremLig = FL1.Range("A65535").End(xlUp).Row + 1 Derlig = FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row For i = PremLig to Derlig FL1.Cells(i, NoCol).value = WK Next
et ça après collage de chaque feuille
Déclare les variables as long
29/05/2007, 21h02
ancel17
je pense qu'il vaudrait mieux remplacer Wk par fich.Name car Wk me donne le chemin complet...

D'autre part est-il possible de retirer l'extention car fich.Name renvoie par exemple Air.xls alors que je voudrais avoir que Air ?
Citation:
Il y a une solution mais en cas de bug, elle est (très) risquée. En voici une que tu peux tester, après la ligne

Code:

1 2 Set CL2 = Workbooks.Open(Wk) CL2.visible = False
Ceci ne fonctionne pas :

Citation:

Propriété ou méthode non gérée par cet objet
Citation:
Tout bien corrigé, ça donnerait ça

Code:

1 2 3 4 5 PremLig = FL1.Range("A65535").End(xlUp).Row + 1 Derlig = FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row For i = PremLig to Derlig FL1.Cells(i, NoCol).value = WK Next

et ça après collage de chaque feuille
Déclare les variables as long
Cela fonctionne très bien mis à part la valeur prise par les cellules (.xls en trop). J'ai trouvé comment faire pour centrer automatiquement la valeur de la cellule, mais pas pour encadrer la cellule.

Pour Application.Activate, je vois pas trop comment faire, mais je vais chercher.
29/05/2007, 21h12
ouskel'n'or

Et d'abord c'est Application.Calculate pas Activate...
Pour le nom de fichier, tu peux mettre

Code:

Cells(....).value = Left(Split(Wk,"\")(Ubound(Split(Wk,"\"),len(Split(Wk,"\")(Ubound(Split(Wk,"\")-4)

Je plaisante bien que ça risque de fonctionner. Prends plutôt

Code:

Cells(...).value = Left(fich.Name, len(fich.Name)-4)

A+
30/05/2007, 08h53
ancel17

Citation:

Et d'abord c'est Application.Calculate pas Activate...

on est d'accord, c'est juste une erreur de ma part lors du post...

Sinon pour le nom du fichier, c'est nickel
30/05/2007, 09h25
ouskel'n'or

Application.calculate ne fonctionne pas ? Tu as jeté un coup d'oeil dans l'aide ?
30/05/2007, 09h33
ancel17

c'est à dire que si je mets application.calculate dans la sub worksheet_activate, ce n'est pris en compte que lorsque la feuille sommaire est dans l'état actif, ce qui n'est jamais le cas lors d'un retour après navigation entre différents fichiers.

D'ailleurs je me suis rendu compte ce matin que le tableau n'était pas recalculé lors de l'ouverture du fichier...

sinon, pour les bordures des cellules, tu as une solution ? j'ai essayé borders, mais c'est pas géré par Cells.

Tu veux encadrer les feuilles rassemblées ?
Je ne sais plus les noms de feuilles mais pour la syntaxe...

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
Sub Bordure()
with worksheets("Feuil1").range("A1:" & Worksheets("Feuil1").range("A1").SpecialCells(xlCellTypeLastCell).Address(false, false))
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With .Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End With
 
End Sub

Que tu peux simplifier si tu veux des lignes classiques, noires, de l'épaisseur par défaut.

Code:

1
2
3
4
5
6
7
8
With Worksheets("Feuil1").Range("A1:" & Worksheets("Feuil1").Range("A1").SpecialCells(xlCellTypeLastCell).Address(False, False))
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With

A+

Essaie FL1.Calculate

Merci pour les bordures !

Voici le code complet actuel. Le souci qu'il reste vient toujours du fait que le tableau n'est pas recalculé automatiquement à chaque affichage de la feuille, que ce soit à l'ouverture du fichier, ou au retour après navigation.
Actuellement, je suis toujours obligé de basculer d'une feuille à une autre pour que le tableau soit calculé.

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Private Sub Worksheet_Activate()
 
Dim fso As New FileSystemObject
Dim fich As file
Dim Rep As Folder
Dim Wk As Variant
Dim TabFich() As String
Dim CL1 As Workbook, CL2 As Workbook
Dim FL1 As Worksheet, FL2 As Worksheet
Dim Premlig As Long, Derlig As Long
 
    FL1.Calculate
 
    Set CL1 = ThisWorkbook
    Set FL1 = CL1.Worksheets("Sommaire")
    Set Rep = fso.GetFolder(Application.ThisWorkbook.Path & "\Thèmes")
 
            FL1.Rows("74:65536").Delete
 
            For Each fich In Rep.Files
                Wk = Rep & "\" & fich.Name
                If fso.GetExtensionName(Wk) = "xls" Then
                    CL1.Save
                    Premlig = FL1.Range("A65535").End(xlUp).Row + 1
                    Set CL2 = Workbooks.Open(Wk)
                    Set FL2 = CL2.Worksheets("sommaire")
                        FL2.Range("A15:" & FL2.Range("A1"). _
                        SpecialCells(xlCellTypeLastCell).Address).Copy _
                        Destination:=FL1.Range("B" & FL1.Range("B1"). _
                        SpecialCells(xlCellTypeLastCell).Row + 1)
                        Derlig = FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row
                        For i = Premlig To Derlig
                            FL1.Cells(i, 1).Value = Left(fich.Name, Len(fich.Name) - 4)
                        Next
                        CL2.Close
                End If
            Next
            With FL1.Range("A74:" & "G" & FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row)
                .VerticalAlignment = xlVAlignCenter
                .HorizontalAlignment = xlHAlignCenter
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlInsideVertical).LineStyle = xlContinuous
                .Borders(xlInsideHorizontal).LineStyle = xlContinuous
            End With
 
    Set Rep = Nothing
    Set FL1 = Nothing
    Set CL1 = Nothing
    Set FL2 = Nothing
    Set CL2 = Nothing
 
End Sub

En tout cas, merci pour ton aide qui m'a déjà été très précieuse !

30/05/2007, 11h30
ouskel'n'or

Je vois que tu places FL1.Calculate en tête de macro, c'est à placer après tout ton code, juste avant set FL1 = Nothing (voui, parce que sinon FL1 il est pas reconnu :mouarf: )
Tu me tiens au courant
A+
30/05/2007, 11h58
ancel17

Certes, mais ça ne change le fait que la sub est prise en compte sur l'activation de la feuille.

J'ai déplacé la ligne au bon endroit, mais ça ne fonctionne pas mieux (vu que ça ne fonctionnait déjà pas avant :mouarf: )
30/05/2007, 12h35
ouskel'n'or
Remplace la ligne par
Code:

1 2 3 4 If Application.CalculationVersion <> _ Workbooks(1).CalculationVersion Then Application.CalculateFull End If
Si ça fonctionne, tu pourras simplifier en ne mettant que la dernière ligne
Tu dis

En désespoir de cause :(
30/05/2007, 16h53
ancel17

Merci de ton aide !

je vais essayer ta dernière proposition, mais je ne pense pas que cela fonctionnera mieux vu que le problème c'est faire comprendre que la feuille est activée...

si ça ne fonctionne pas, je mettrai un bouton de commande pour la mise à jour.

Encore merci !
01/06/2007, 11h26
ancel17

Salut !

donc comme suspecté la dernière fois, le code que tu me donnes doit certainement fonctionner, à condition que la feuille soit reconnue active...

J'avais envisagé de créer un bouton de commande, mais je pense que le plus simple serait de double cliquer sur une cellule.

Est-il possible de lancer la procédure sur double clique d'une cellule en particulier, et si oui, comment ?
01/06/2007, 12h37
ouskel'n'or
Tu devrais essayer Application.calculation = xlCalculationAutomatic au lieu de Application.calculate :mouarf: Oui, je ne comprends toujours pas :(
Pour ton dernier pb, tu dois mettre ce code dans la feuille de code de la feuille concernée
Code:

1 2 3 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address(False, False) = "A1" Then Application.Run ("Fichier.xls!LaMacro") End Sub
A1 : Ta cellule
Fichier.xls : le fichier contenant la macro à exécuter.
Si ta macro est dans le même fichier, tu peux simplement mettre

Code:

LaMacro

A+

NB - Tu n'as pas d'événement Click pour les cellules, tu n'as que l'événement SelectionChange de la feuille de calculs qui peut (à peu près) être assimilé à un clic... sauf que tu dois identifier l'adresse de la cellule.

j'ai mis le code de calcul du tableau dans une macro (module 1) :

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
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
Sub maj()
 
Dim fso As New FileSystemObject
Dim fich As file
Dim Rep As Folder
Dim Wk As Variant
Dim TabFich() As String
Dim CL1 As Workbook, CL2 As Workbook
Dim FL1 As Worksheet, FL2 As Worksheet
Dim Premlig As Long, Derlig As Long
 
    Set CL1 = ThisWorkbook
    Set FL1 = CL1.Worksheets("Sommaire")
    Set Rep = fso.GetFolder(Application.ThisWorkbook.Path & "\Thèmes")
 
            FL1.Rows("74:65536").Delete
 
            For Each fich In Rep.Files
                Wk = Rep & "\" & fich.Name
                If fso.GetExtensionName(Wk) = "xls" Then
                    CL1.Save
                    Premlig = FL1.Range("A65535").End(xlUp).Row + 1
                    Set CL2 = Workbooks.Open(Wk)
                    Set FL2 = CL2.Worksheets("sommaire")
                        FL2.Range("A15:" & FL2.Range("A1"). _
                        SpecialCells(xlCellTypeLastCell).Address).Copy _
                        Destination:=FL1.Range("B" & FL1.Range("B1"). _
                        SpecialCells(xlCellTypeLastCell).Row + 1)
                        Derlig = FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row
                        For i = Premlig To Derlig
                            FL1.Cells(i, 1).Value = Left(fich.Name, Len(fich.Name) - 4)
                        Next
                        CL2.Close
                End If
            Next
            With FL1.Range("A74:" & "G" & FL1.Range("A1").SpecialCells(xlCellTypeLastCell).Row)
                .VerticalAlignment = xlVAlignCenter
                .HorizontalAlignment = xlHAlignCenter
                .Borders(xlEdgeLeft).LineStyle = xlContinuous
                .Borders(xlEdgeTop).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlInsideVertical).LineStyle = xlContinuous
                .Borders(xlInsideHorizontal).LineStyle = xlContinuous
            End With
 
    'FL1.Calculate
 
    Set Rep = Nothing
    Set FL1 = Nothing
    Set CL1 = Nothing
    Set FL2 = Nothing
    Set CL2 = Nothing
 
End Sub

j'ai ensuite le code suivant sur ma feuille :

Code:

1
2
3
4
5
6
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
If Target.Address(False, False) = "A71" Then Application.Run maj
End If
 
End Sub

lorsque je clique sur une cellule, j'ai l'erreur suivante :

Citation:

Fonction ou variable attendue

, et maj est sélectionné.

04/06/2007, 14h59
ancel17
Le problème est résolu :
Code:

1 2 3 4 5 6 Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Address(False, False) = "A71" Then maj End If End Sub
NB : si la cellule cible est fusionnée avec d'autre, il faut remplacer "A71" par la plage correspondante à la fusion ("A71:B72")

Merci pour ton aide Ouskel'n'or !