Copier/coller des colonnes sans les cellules vides

Titia974 -  
Bonjour,

Je me tourne une nouvelle fois vers vous car j'ai un problème. J'aimerais copier/coller certaines colonne de ma 1ère feuille vers une autre feuille sans les cellules vides. J'ai créé une macro mais dès qu'une colonne est vide il y a un bug. Voici ma macro :
Sub Commentaires()
'
' Commentaires Macro
'

'
ActiveWindow.ScrollRow = 4
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 27
ActiveWindow.ScrollRow = 30
ActiveWindow.ScrollRow = 81
ActiveWindow.ScrollRow = 90
ActiveWindow.ScrollRow = 164
ActiveWindow.ScrollRow = 172
ActiveWindow.ScrollRow = 242
ActiveWindow.ScrollRow = 249
ActiveWindow.ScrollRow = 317
ActiveWindow.ScrollRow = 318
ActiveWindow.ScrollRow = 365
ActiveWindow.ScrollRow = 371
ActiveWindow.ScrollRow = 411
ActiveWindow.ScrollRow = 412
ActiveWindow.ScrollRow = 435
ActiveWindow.ScrollRow = 436
ActiveWindow.ScrollRow = 448
ActiveWindow.ScrollRow = 450
ActiveWindow.ScrollRow = 459
ActiveWindow.ScrollRow = 460
ActiveWindow.ScrollRow = 465
ActiveWindow.ScrollRow = 467
ActiveWindow.ScrollRow = 478
ActiveWindow.ScrollRow = 479
ActiveWindow.ScrollRow = 484
ActiveWindow.ScrollRow = 487
Range("K3:K502").Select
Selection.SpecialCells(xlCellTypeConstants, 3).Select
Selection.Copy
Sheets("Commentaires").Select
Range("A6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Saisie").Select
ActiveWindow.SmallScroll Down:=-15
Range("N3").Select
ActiveWindow.ScrollRow = 9
ActiveWindow.ScrollRow = 10
ActiveWindow.ScrollRow = 45
ActiveWindow.ScrollRow = 54
ActiveWindow.ScrollRow = 117
ActiveWindow.ScrollRow = 124
ActiveWindow.ScrollRow = 225
ActiveWindow.ScrollRow = 236
ActiveWindow.ScrollRow = 335
ActiveWindow.ScrollRow = 346
ActiveWindow.ScrollRow = 389
ActiveWindow.ScrollRow = 390
ActiveWindow.ScrollRow = 412
ActiveWindow.ScrollRow = 414
ActiveWindow.ScrollRow = 432
ActiveWindow.ScrollRow = 433
ActiveWindow.ScrollRow = 450
ActiveWindow.ScrollRow = 451
ActiveWindow.ScrollRow = 463
ActiveWindow.ScrollRow = 464
ActiveWindow.ScrollRow = 481
ActiveWindow.ScrollRow = 482
ActiveWindow.ScrollRow = 494
Range("N3:N502").Select
Selection.SpecialCells(xlCellTypeConstants, 3).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Commentaires").Select
Range("B6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A14").Select
Sheets("Saisie").Select
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 15
ActiveWindow.SmallScroll Down:=-18
Range("T3").Select
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 5
ActiveWindow.ScrollRow = 69
ActiveWindow.ScrollRow = 79
ActiveWindow.ScrollRow = 191
ActiveWindow.ScrollRow = 202
ActiveWindow.ScrollRow = 325
ActiveWindow.ScrollRow = 339
ActiveWindow.ScrollRow = 430
ActiveWindow.ScrollRow = 437
ActiveWindow.ScrollRow = 482
ActiveWindow.ScrollRow = 489
ActiveWindow.ScrollRow = 495
Range("T3:T502").Select
Selection.SpecialCells(xlCellTypeConstants, 3).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Commentaires").Select
Range("C6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B11").Select
Sheets("Saisie").Select
ActiveWindow.ScrollColumn = 16
ActiveWindow.ScrollColumn = 17
ActiveWindow.SmallScroll Down:=-15
Range("Y3").Select
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 25
ActiveWindow.ScrollRow = 32
ActiveWindow.ScrollRow = 137
ActiveWindow.ScrollRow = 152
ActiveWindow.ScrollRow = 271
ActiveWindow.ScrollRow = 281
ActiveWindow.ScrollRow = 368
ActiveWindow.ScrollRow = 377
ActiveWindow.ScrollRow = 429
ActiveWindow.ScrollRow = 430
ActiveWindow.ScrollRow = 480
ActiveWindow.ScrollRow = 481
ActiveWindow.ScrollRow = 493
ActiveWindow.ScrollRow = 494
ActiveWindow.ScrollRow = 495
Range("Y3:Y502").Select
Selection.SpecialCells(xlCellTypeConstants, 3).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Commentaires").Select
Range("D6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Saisie").Select
ActiveWindow.SmallScroll ToRight:=5
ActiveWindow.SmallScroll Down:=-15
Range("AA3").Select
ActiveWindow.ScrollRow = 3
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 148
ActiveWindow.ScrollRow = 161
ActiveWindow.ScrollRow = 279
ActiveWindow.ScrollRow = 286
ActiveWindow.ScrollRow = 346
ActiveWindow.ScrollRow = 352
ActiveWindow.ScrollRow = 387
ActiveWindow.ScrollRow = 393
ActiveWindow.ScrollRow = 440
ActiveWindow.ScrollRow = 441
ActiveWindow.ScrollRow = 462
ActiveWindow.ScrollRow = 463
ActiveWindow.ScrollRow = 478
ActiveWindow.ScrollRow = 479
ActiveWindow.ScrollRow = 481
ActiveWindow.ScrollRow = 482
ActiveWindow.ScrollRow = 484
Range("AA3:AA502").Select
Selection.SpecialCells(xlCellTypeConstants, 3).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Commentaires").Select
Range("E6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F6").Select
Sheets("Saisie").Select
ActiveWindow.SmallScroll Down:=-9
Range("AB3").Select
ActiveWindow.SmallScroll Down:=18
ActiveWindow.ScrollRow = 21
ActiveWindow.ScrollRow = 46
ActiveWindow.ScrollRow = 55
ActiveWindow.ScrollRow = 137
ActiveWindow.ScrollRow = 156
ActiveWindow.ScrollRow = 269
ActiveWindow.ScrollRow = 277
ActiveWindow.ScrollRow = 372
ActiveWindow.ScrollRow = 373
ActiveWindow.ScrollRow = 401
ActiveWindow.ScrollRow = 410
ActiveWindow.ScrollRow = 451
ActiveWindow.ScrollRow = 452
ActiveWindow.ScrollRow = 465
ActiveWindow.ScrollRow = 467
ActiveWindow.ScrollRow = 474
ActiveWindow.ScrollRow = 475
ActiveWindow.ScrollRow = 476
ActiveWindow.ScrollRow = 478
ActiveWindow.ScrollRow = 481
ActiveWindow.ScrollRow = 483
Range("AB3:AB502").Select
Selection.SpecialCells(xlCellTypeConstants, 3).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Commentaires").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("G11").Select
End Sub

Serait-il possible de m'aider car je n'arrive pas à trouver de solutions.

Merci d'avance.

18 réponses

  2. Gyrus
    A priori, si le programme ne passe jamais par la ligne 
    "Sheets("Commentaires").Cells(6, i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False"

    c'est qu'une erreur est générée par l'instruction 
    .Range(C(i)).SpecialCells(xlCellTypeConstants, 3).Copy

    Avec ce code modifié, tu pourras visualiser cette erreur 
    Option Explicit
    Option Base 1
    Sub Commentaires()
    Dim C
    Dim i As Integer
    Dim Msg As String
        With Sheets("Saisie")
            C = Array("K3:K502", "N3:N502", "T3:T502", "Y3:T502", "AA3;AA502", "AB3:AB502")
            On Error Resume Next
            For i = 1 To UBound(C)
                .Range(C(i)).SpecialCells(xlCellTypeConstants, 3).Copy
                If Err.Number = 0 Then
                    Sheets("Commentaires").Cells(6, i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                Else
                    Msg = "L'erreur # " & Str(Err.Number) & " a été générée par " _
                        & Err.Source
                    MsgBox Msg, , "Erreur", Err.HelpFile, Err.HelpContext
                    Err.Clear
                    End If
                Next i
                Application.CutCopyMode = False
            End With
    End Sub

    J'ai du mal à comprendre puisque l'on fait tourner le même programme sur les mêmes données.
    Quelle est ta version Excel (Excel 2007 de mon coté) ?

    A+
    1
    1. Gyrus
      Essaie de désactiver Eurotool

      Clic sur l'icône Office > Options Excel
      Compléments > Gérer Compléments Excel \ Atteindre
      Désactive le complément Eurotool.xlam
      Clic sur OK

      A+
      1
      3. Zoul67
        Bonjour,

        Peux-tu enlever tous les ActiveWindow.ScrollRow dans ta question (et dans ta macro) ? ça alourdit et ne sert pas (ça correspond à l'action sur la roulette).

        A+
        0
        1. Gyrus
          Bonjour,

          Une solution avec gestion de l'erreur 
          Option Explicit
          Option Base 1
          Sub Commentaires()
          Dim C
          Dim i As Integer
              With Sheets("Saisie")
                  C = Array("K3:K502", "N3:N502", "T3:T502", "Y3:Y502", "AA3:AA502", "AB3:AB502")
                  On Error Resume Next
                  For i = 1 To UBound(C)
                      Range(C(i)).SpecialCells(xlCellTypeConstants, 3).Copy
                      If Err.Number = 0 Then
                          Sheets("Commentaires").Cells(6, i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                          :=False, Transpose:=False
                      Else
                          Err.Clear
                      End If
                  Next i
                  Application.CutCopyMode = False
              End With
          End Sub

          A+
          0
          1. Titia_974
            Merci de l'aide mais lorsque je tape :
            Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

            Il me dit :
            "Erreur de compilation:
            Attendu : Expression"

            Et le texte se met en rouge.

            Pourrais-tu m'éclairer ?

            Merci d'avance.
            0
            1. Zoul67
              Supprime le saut de ligne après PasteSpecial
              0
          2. Titia_974
            J'ai bien entré cette macro :
            Option Explicit
            Option Base 1
            Sub Commentaires()
            Dim C
            Dim i As Integer
            With Sheets("Saisie")
            C = Array("K3:K502", "N3:N502", "T3:T502", "Y3:T502", "AA3;AA502", "AB3:AB502")
            On Error Resume Next
            For i = 1 To UBound(C)
            Range(C(i)).SpecialCells(xlCellTypeConstants, 3).Copy
            If Err.Number = 0 Then
            Sheets("Commentaires").Cells(6, i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            Else
            Err.Clear
            End If
            Next i
            Application.CutCopyMode = False
            End With
            End Sub

            Mais lorsque que je fais "play" rien ne se passe. Comment ça se fait ?
            0
            4. Titia_974
              Maintenant plus rien ne se passe. Lorsque je fais play, il n'y a rien.

              Que dois-je faire ?

              Merci beaucoup.
              0
              1. Titia_974
                Il ne se passe rien même avec le bouton. :(
                0
                1. Zoul67
                  As-tu activé les macros ?!
                  0
              2. Gyrus
                Et quand tu lances la macro en pas à pas détaillé ?
                0
                1. Titia_974
                  Oui les macros sont bien activées. Et lorsque je fais en pas à pas détaillé il me surligne en jaune pas à pas les lignes de la macro sauf pour :
                  "Dim C
                  Dim i As Integer"

                  "Sheets("Commentaires").Cells(6, i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                  :=False, Transpose:=False"

                  "Application.CutCopyMode = False
                  End With
                  End Sub"
                  0
                  1. Titia_974
                    Ma version est comme la tienne : Excel 2007.
                    Après avoir repris ta dernière macro voilà ce qu'il me dit :
                    "L'erreur # a été générée par EuroTool"
                    0
                    1. Titia_974
                      Plus précisément :
                      - "L'erreur # 9 a été généré par EuroTool"
                      - "L'erreur # 9 a été générée par EuroTool"
                      - "L'erreur # 1004 a été générée par Microsoft Office Excel"
                      - "L'erreur # 1004 a été générée par Microsoft Office Excel"
                      - "L'erreur # 1004 a été générée par VBA Project"
                      - "L'erreur # 9 a été générée par EuroTool

                      Et voilà ! :(
                      0
                  2. Titia_974
                    Je n'ai pas Eurotool.xlam dans les macros complémentaires. Par contre j'ai "outils pour l'euro qui est coché".
                    0
                    1. Titia_974
                      Ca marche !!!! :D

                      Merci merci merci :)
                      0

                      Discussions similaires

                      Arobase
                      Zezette

                      1 réponse