Discussion :

[guismoman33]

J'aimerai cliquez sur une case (A1) pour copier les case de A9 à E13 de la page 1 et de les mettre sur la page 13...Mais pas les copier normalement j'aimerai que les colonne devienne les ligne et que les ligne devienne les colonnes...Et tout c'est commande la je ne les connait pas...S'il vous plait aidez moi j'aimerai juste qu'on me donne les bout de code pour faire ceci...

[tonton fred]

Bonjour,
Lance l'editeur de macro, copie tes cellules et au lieu de coller tu fait collage special -> transposer.

[guismoman33]

Mais comment fait on pour faire d'une case un bouton, quand j'appuie sur la case A1 je veux qu'il active la macro8

[guismoman33]

Après une reflexion j'ai trouver un logaritme pour ma selection de colonne mais je ne seriat pas la metttre en appilcation sous cause que je n'est pas les commende

boucle de A25 à I25
si lacase=0 alors
ne pas sélectionné la colonne
sinon
la selectionné
fin boucle

Voila comment mettre dans une variable toute la selection pour ensuite la copier etc...

[mordrhim]

allez je suis de bon coeur ^^

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    Dim TrgLi As Integer
    Dim TrgCo As Integer
 
    TrgCo = Target.Column
    TrgLi = Target.Row
 
    Application.ScreenUpdating = False
 
    If TrgLi = 1 And TrgCo = 1 Then
        Range("A9:E13").Copy
        Feuil2.Range("A9").PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
            , Transpose:=True
    End If
    Target.Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

apres tu remplaces Feuil2 par le nom de ta feuille n° 13 (le nom dans VBA pas celui que tu vois sur le classeur)
et tu remplace TrgLi et TrgCo par les coordonnées de la cellule "bouton"

[guismoman33]

je te remercie, il manque juste un truc ma boucle avec ma condition??ceci est important car je veux pas tout copier je veux copier que les colonne rempie et nous les reperons grace à la ligne 25...regarde dans l'algo mais tu m'en a deja fait beaucoup merci

[guismoman33]

Code :

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

1
2
Target.Column = 3
    Target.Row = 1

La syntaxe n'est pas bonne, et l'aide ne me permet pas de repondre si vous pouviez encore m'aidez

[guismoman33]

c bon j'ai trouver mais j'ai toujours ce problème au niveau de la condition de selection. Il me dit qu'il ya une erreur a cette ligne :

Code :

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

Target.Select

[mordrhim]

Désolé, j'ai eu crash internet ^^

Code :

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

1
2
Target.Column = 3
    Target.Row = 1

La syntaxe n'est pas bonne, et l'aide ne me permet pas de repondre si vous pouviez encore m'aidez

non dans

Code :

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

If TrgLi = 1 And TrgCo = 1 Then

tu remplaces les 1 par les coordonnées ^^

sinon pour la selection ya un truc du genre

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
Private Sub Algorithme()
    Dim Colonne As Integer
    Dim SelectionTotale As String
 
    SelectionTotale = ""
    For Colonne = 1 To 9
 
'Pour pallier à mon manque de connaissance de conversion chiffre en lettre
    If Colonne = 1 Then
    Conv = "A"
    ElseIf Colonne = 2 Then
    Conv = "B"
    ElseIf Colonne = 3 Then
    Conv = "C"
    ElseIf Colonne = 4 Then
    Conv = "D"
    ElseIf Colonne = 5 Then
    Conv = "E"
    ElseIf Colonne = 6 Then
    Conv = "F"
    ElseIf Colonne = 7 Then
    Conv = "G"
    ElseIf Colonne = 8 Then
    Conv = "H"
    ElseIf Colonne = 9 Then
    Conv = "I"
    End If
 
    If Cells(25, Colonne) <> 0 Then
        SelectionTotale = SelectionTotale & Conv & ":" & Conv & ","
    End If
 
   Next
    SelectionTotale = Left(SelectionTotale, Len(SelectionTotale) - 1) 'Je supprimme le dernier ','
 
    Range(SelectionTotale).Copy
End Sub

ca te copiera les colonnes ou les cellules de la ligne 25 sont différente de 0
par contre, lorsque tu as des erreurs sur ton programme, pourrais tu s'il te plait mettre ton code ^^

[guismoman33]

yes

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
    Dim TrgLi As Integer
    Dim TrgCo As Integer
 
 
    TrgLi = Target.Column
    TrgCo = Target.Row
 
    Application.ScreenUpdating = False
 
    If TrgLi = 1 And TrgCo = 3 Then
        Range("A6:I25").Copy
        Feuil21.Range("A9").PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
            , Transpose:=True
    End If
    Target.Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

voila mon code où il y a une erreur...
Je me suis sans doute mal expliqué j'aimerai avoir une condition sur la ligne 25 pour savoir si la colonne est rempli, si elle est rempli je la selectionne pour la copié en collage spécial.
Car pour le moment le code que je vien d'inscire me sert à tout copier même les colonne vide et sa ne m'interresse pas sa...Je demande beaucoup de truc car ceci est un code assez complexe je pense et je ne suis pas de niveau une fois réussi je réussirai à m'améliorer encore plus...
Merci de votre aide, ceci est un programme qui est important pour moi, mais assez complexe, je tente des chose mais ceci ne marche pas rrrrrrrrr

[guismoman33]

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
 
    Dim Colonne As Integer
    Dim SelectionTotale As String
    Dim TrgLi As Integer
    Dim TrgCo As Integer
 
 
    TrgLi = Target.Column
    TrgCo = Target.Row
 
    Application.ScreenUpdating = False
 
    If TrgLi = 1 And TrgCo = 3 Then
    SelectionTotale = ""
    For Colonne = 1 To 9
 
'Pour pallier à mon manque de connaissance de conversion chiffre en lettre
    If Colonne = 1 Then
    Conv = "A"
    ElseIf Colonne = 2 Then
    Conv = "B"
    ElseIf Colonne = 3 Then
    Conv = "C"
    ElseIf Colonne = 4 Then
    Conv = "D"
    ElseIf Colonne = 5 Then
    Conv = "E"
    ElseIf Colonne = 6 Then
    Conv = "F"
    ElseIf Colonne = 7 Then
    Conv = "G"
    ElseIf Colonne = 8 Then
    Conv = "H"
    ElseIf Colonne = 9 Then
    Conv = "I"
    End If
 
    If Cells(25, Colonne) <> 0 Then
        SelectionTotale = SelectionTotale & Conv & ":" & Conv & ","
    End If
 
   Next
    SelectionTotale = Left(SelectionTotale, Len(SelectionTotale) - 1) 'Je supprimme le dernier ','
 
    Range(SelectionTotale).Copy
 
        Feuil21.Range("A9").PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
            , Transpose:=True
    End If
    Target.Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
 
End Sub

J'ai l'impression qu emon code ne veux rien dire et qu'il ne va pas faire se que je veux...Le débugueur me dit que l'erreur ce trouve ici

Target.Select

IL me dit : la méthode selct de la classe range à echouer

[mordrhim]

daja une chose fait attention a ces deux lignes de ton code

Code :

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

1
2
TrgLi = Target.Column
TrgCo = Target.Row

TrgLi etant la ligne (que tu référence en colonne) et TrgCo (étant la colonne que tu référence en ligne)

petites modifications :

je vais te filer le code que j'ai fait, étudie le sans le copier comme un "étudiant rédigeant un dossier"

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
77
78
79
80
81
82
83
84
85
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
'Initialisation des variables utilisées
    Dim TrgLi As Integer
    Dim TrgCo As Integer
    Dim Colonne As Integer
    Dim SelectionPlage As String
    Dim CelluleCollage As String
    Dim Cellule As Range
    Dim SelectionVide As Boolean
    Dim MonAlphabet
 
    TrgLi = Target.Row
    TrgCo = Target.Column
 
    Application.ScreenUpdating = False 'Pour ne pas que l'écran "bouge"
 
    If TrgLi = 1 And TrgCo = 3 Then
'Définition de la traduction chiffre lettre pour la référence des colonnes
        MonAlphabet = Array("", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P")
 
'Pour demander la référence de la première cellule où coller 
       CelluleCollage = ""
        Do While CelluleCollage = "" 'Test (Simpliste) que la cellule est bien donnée (en gros si on donne rien c'est pas bon
            CelluleCollage = InputBox("Quelle sera la premère cellule de copie ?", "Copie")
            If CelluleCollage = "" Then MsgBox ("Veuillez entrer une référence de cellule")
        Loop
        For Colonne = 1 To 9
            Conv = MonAlphabet(Colonne) 'je convertit le chiffre de colonne en lettre pour le range
 
'Ici je regarde si la plage de cellule entre les lignes 6 et 25 de la colonne étudiée est totalement vide.
            For Each Cellule In Range(Cells(6, Colonne), Cells(25, Colonne))
                SelectionVide = True
                If Cellule.Value <> Empty Then
                    SelectionVide = False
                    Exit For
                End If
            Next
'Si elle ne l'est pas je commence la séléction
            If Not SelectionVide Then
                MsgBox ("Colonne " & Conv & " séléctionnée ")
                SelectionVide = False
                SelectionPlage = SelectionPlage & Conv & "6:" 'Création de l'adresse de séléction a copier (range)
 
'Juste pour copier par bloc de colonne plutot que par colonne
                Do Until SelectionVide
'Même test que précédement, la plage est-elle totalement vide ?
                    For Each Cellule In Range(Cells(6, Colonne + 1), Cells(25, Colonne + 1))
                        SelectionVide = True
                        If Cellule.Value <> Empty Then
                            SelectionVide = False
                            Exit For
                        End If
                    Next
'Si elle est vide on a un bloc !
                    If SelectionVide Then
                        Exit Do
 
 
'Sinon, on augmente le bloc avec la nouvelle colonne
                    Else
                        Colonne = Colonne + 1
                        MsgBox ("Colonne " & MonAlphabet(Colonne) & " séléctionnée ")
                    End If
                Loop
                Conv = MonAlphabet(Colonne)
'Le bloc de colonne étant défini, on le rajoute à la séléction à copier
                SelectionPlage = SelectionPlage & Conv & "25,"
            End If
        Next
'Lorsque tout les blocs sont ajoutés à la séléction de copie, on supprime la dernière "," (pour pas ça bug)
        SelectionPlage = Left(SelectionPlage, Len(SelectionPlage) - 1)
'Je copie la séléction
        Range(SelectionPlage).Copy
'Je la colle anec un "Transpose"
        Feuil21.Range(CelluleCollage).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=True _
            , Transpose:=True
    End If
'Je selectionne la cellule bouton
    Target.Select
'J'annule la séléction de copie
    Application.CutCopyMode = False
'Je permet à nouveau que le classeur "bouge"
    Application.ScreenUpdating = True
End Sub

Les MsgBox sont la pour les test tu peux les supprimer si tu veux ^^

[guismoman33]

Après avoir étudiez ton programme je les tester et il me met toujours la meme erreur...La ligne 25 est la ligne résultat, le test fait que si il n'y a pas de résultat la colonne n'est pas active donc je la selectionne pas..C'est bien se que tu avait compris??

[mordrhim]

remplace

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
        For Colonne = 1 To 9
            Conv = MonAlphabet(Colonne) 'je convertit le chiffre de colonne en lettre pour le range
 
'Ici je regarde si la plage de cellule entre les lignes 6 et 25 de la colonne étudiée est totalement vide.
            For Each Cellule In Range(Cells(6, Colonne), Cells(25, Colonne))
                SelectionVide = True
                If Cellule.Value <> Empty Then
                    SelectionVide = False
                    Exit For
                End If
            Next
'Si elle ne l'est pas je commence la séléction
            If Not SelectionVide Then
                MsgBox ("Colonne " & Conv & " séléctionnée ")
                SelectionVide = False
                SelectionPlage = SelectionPlage & Conv & "6:" 'Création de l'adresse de séléction a copier (range)
 
'Juste pour copier par bloc de colonne plutot que par colonne
                Do Until SelectionVide
'Même test que précédement, la plage est-elle totalement vide ?
                    For Each Cellule In Range(Cells(6, Colonne + 1), Cells(25, Colonne + 1))
                        SelectionVide = True
                        If Cellule.Value <> Empty Then
                            SelectionVide = False
                            Exit For
                        End If
                    Next
'Si elle est vide on a un bloc !
                    If SelectionVide Then
                        Exit Do
 
 
'Sinon, on augmente le bloc avec la nouvelle colonne
                    Else
                        Colonne = Colonne + 1
                        MsgBox ("Colonne " & MonAlphabet(Colonne) & " séléctionnée ")
                    End If
                Loop
                Conv = MonAlphabet(Colonne)
'Le bloc de colonne étant défini, on le rajoute à la séléction à copier
                SelectionPlage = SelectionPlage & Conv & "25,"
            End If
        Next

par

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
        For Colonne = 1 To 9
            Conv = MonAlphabet(Colonne)
            If Cells(25, Colonne) <> 0 Then
                MsgBox ("Colonne " & Conv & " séléctionnée ")
                SelectionVide = False
                SelectionPlage = SelectionPlage & Conv & "6:"
                Do While Cells(25, Colonne + 1) <> 0
                    Colonne = Colonne + 1
                    MsgBox ("Colonne " & MonAlphabet(Colonne) & " séléctionnée ")
                Loop
                Conv = MonAlphabet(Colonne)
                SelectionPlage = SelectionPlage & Conv & "25,"
            End If
        Next

et supprime

Code :

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

Target.Select

et oublie pas le lorsque tu seras satisfait

[guismoman33]

sa ne marche toujours pas et en plus on dirai kil y a un truc qui ce met toujours a jour lorsque jappuie sur n'importe quel case

[guismoman33]

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
'Initialisation des variables utilisées
    Dim TrgLi As Integer
    Dim TrgCo As Integer
    Dim Colonne As Integer
    Dim SelectionPlage As String
    Dim CelluleCollage As String
    Dim Cellule As Range
    Dim SelectionVide As Boolean
    Dim MonAlphabet
 
    TrgLi = Target.Row
    TrgCo = Target.Column
 
    Application.ScreenUpdating = False 'Pour ne pas que l'écran "bouge"
 
    If TrgLi = 1 And TrgCo = 3 Then
'Définition de la traduction chiffre lettre pour la référence des colonnes
        MonAlphabet = Array("", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P")
 
'Pour demander la référence de la première cellule où coller
       CelluleCollage = ""
        Do While CelluleCollage = "" 'Test (Simpliste) que la cellule est bien donnée (en gros si on donne rien c'est pas bon
            CelluleCollage = InputBox("Quelle sera la premère cellule de copie ?", "Copie")
            If CelluleCollage = "" Then MsgBox ("Veuillez entrer une référence de cellule")
        Loop
        For Colonne = 1 To 9
            Conv = MonAlphabet(Colonne)
            If Cells(25, Colonne) <> 0 Then
                MsgBox ("Colonne " & Conv & " séléctionnée ")
                SelectionVide = False
                SelectionPlage = SelectionPlage & Conv & "6:"
                Do While Cells(25, Colonne + 1) <> 0
                    Colonne = Colonne + 1
                    MsgBox ("Colonne " & MonAlphabet(Colonne) & " séléctionnée ")
                Loop
                Conv = MonAlphabet(Colonne)
                SelectionPlage = SelectionPlage & Conv & "25,"
            End If
        Next
'Lorsque tout les blocs sont ajoutés à la séléction de copie, on supprime la dernière "," (pour pas ça bug)
        SelectionPlage = Left(SelectionPlage, Len(SelectionPlage) - 1)
'Je copie la séléction
        Range(SelectionPlage).Copy
'Je la colle anec un "Transpose"
        Feuil21.Range(CelluleCollage).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=True _
            , Transpose:=True
    End If
'J'annule la séléction de copie
    Application.CutCopyMode = False
'Je permet à nouveau que le classeur "bouge"
    Application.ScreenUpdating = True
End Sub

Je comprend vraiment plus rien la, je comprend le code mais je comprend pas les réaction qu'il a.
ATTEnd je veux prendre les colonne selectionné(page 3) et les collez page 21

[mordrhim]

ce code va regarder si le total en ligne 25 est nul ou pas

s'il n'est pas nul, il rajoute la colonne, entre la ligne 6 et la 25, a la séléction totale.

ensuite cette sélection, composée des blocs "ligne 6 -> ligne25 dont le total est non nul", il la copie dans la feuille 21 en transformant les lignes ne colonne et vice versa.

il faut que tu le mette sur la page de code de la feuille 3.

perso je ne vois pas la difficulté et ne vois pas non plus ce que tu ne comprends pas ^^

[guismoman33]

C'est ce que j'ai fais enfin c la feuille2 mais c pas le probleme je les bien mis ou il faut.
Mais 1/ sa ne marche pa
2/ A chaque fois que je change de cellule sur la feuille2 ma feuille fait comme ci elle se rafraichissait. c'est tres chiant.
Il me met pas la message box en plus...

[mordrhim]

pour que le "rafraichissement" ne se fasse pas utilise un bouton.

tu supprimes les lignes

Code :

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

1
2
3
Dim TrgLi As Integer
Dim TrgCo As Integer
If TrgLi = 1 And TrgCo = 3 Then 'Et son End If

tu change

Code :

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

par

Code :

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

Private Sub TransfertCellule()

tu associe la macro TransfertCellule au clique du bouton.

si tu ne veux pas de bouton

Code :

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

Application.ScreenUpdating = False

a mettre apres

Code :

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

If TrgLi = 1 And TrgCo = 3 Then

et

Code :

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

1
2
Application.CutCopyMode = False
Application.ScreenUpdating = True

à mettre juste avant le dernier

Code :

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

End If

(Erreur de ma part )

et si ca ne marche pas et bien désolé mais chez moi ca marche pour faire ce que tu as demandé (ou du moins ce que j'ai compris)

alors tu prends mon code, tu l'adapte a ta sauce et tu te débrouille ^^
on est pa là pour bosser à ta place

[guismoman33]

tu va me dire si sa fai bien se que je veux stp...Je pense que tu a compris mais c'est le ddéclenchement, je veux me servir d'une case comme un bouton , que lorsqu'on appuie sur la case A3, le processus ce lance. Je c'est très bien que tu n'es pas la pour bosser a ma place mais je taff mais ce code est trop complexe mais il me faut ceci...
Aide moi une dernière fois is ton code est le même que le mien...

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 
'Initialisation des variables utilisées
    Dim TrgLi As Integer
    Dim TrgCo As Integer
    Dim Colonne As Integer
    Dim SelectionPlage As String
    Dim CelluleCollage As String
    Dim Cellule As Range
    Dim SelectionVide As Boolean
    Dim MonAlphabet
 
    TrgLi = Target.Row
    TrgCo = Target.Column
 
    Application.ScreenUpdating = False 'Pour ne pas que l'écran "bouge"
 
    If TrgLi = 1 And TrgCo = 3 Then
    Application.ScreenUpdating = False
 
'Définition de la traduction chiffre lettre pour la référence des colonnes
        MonAlphabet = Array("", "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P")
 
'Pour demander la référence de la première cellule où coller
       CelluleCollage = ""
        Do While CelluleCollage = "" 'Test (Simpliste) que la cellule est bien donnée (en gros si on donne rien c'est pas bon
            CelluleCollage = InputBox("Quelle sera la premère cellule de copie ?", "Copie")
            If CelluleCollage = "" Then MsgBox ("Veuillez entrer une référence de cellule")
        Loop
        For Colonne = 1 To 9
            Conv = MonAlphabet(Colonne)
            If Cells(25, Colonne) <> 0 Then
                MsgBox ("Colonne " & Conv & " séléctionnée ")
                SelectionVide = False
                SelectionPlage = SelectionPlage & Conv & "6:"
                Do While Cells(25, Colonne + 1) <> 0
                    Colonne = Colonne + 1
                    MsgBox ("Colonne " & MonAlphabet(Colonne) & " séléctionnée ")
                Loop
                Conv = MonAlphabet(Colonne)
                SelectionPlage = SelectionPlage & Conv & "25,"
            End If
        Next
'Lorsque tout les blocs sont ajoutés à la séléction de copie, on supprime la dernière "," (pour pas ça bug)
        SelectionPlage = Left(SelectionPlage, Len(SelectionPlage) - 1)
'Je copie la séléction
        Range(SelectionPlage).Copy
'Je la colle anec un "Transpose"
        Feuil21.Range(CelluleCollage).PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=True _
            , Transpose:=True
            Application.CutCopyMode = False
            Application.ScreenUpdating = True
    End If
'J'annule la séléction de copie
    Application.CutCopyMode = False
'Je permet à nouveau que le classeur "bouge"
    Application.ScreenUpdating = True
End Sub

Et toujours ce problème de rafraischissement bizarre