XL 2013 [Résolu] Question sur : Select Case

Lone-wolf

XLDnaute Barbatruc
Bonsoir à tous :)

Voici la macro que j'ai écrit

Select Case Range("a1").CurrentRegion.Column
Case 3, 5, 7, 9
Target.Column.Copy Sheets("Report").Range("a2")
Case Else
Exit Sub
End Select

Évidemment elle n'est pas correcte, malgré les recherches sur le net je n'ai rien trouvé. Comment on écrit la macro pour qu'elle copie les colonnes choisies?
 

Dranreb

XLDnaute Barbatruc
Bonsoir.
Il faudrait déjà que je comprenne ce que vous voulez faire
La propriété Column d'un Range n'est pas un objet, et n'admet donc pas de méthode Copy derrière.
Columns aurait plus de chance de ne pas planter, à défaut de donner le résultat souhaité…
 

GCFRG

XLDnaute Occasionnel
peut être une autre solution
Code:
Sub test()
'en supposant que toutes les colonnes aient la le même nombre de cellules, sinon prendre la colonne la plus longue

Dim F1 As Worksheet, F2 As Worksheet, I As Long, J As Long, Fin As Long


Set F1 = Sheets("feuil1") 'ou le nom de ta feuille
Set F2 = Sheets("Report")
With F2
Fin = .Range("C" & .Rows.Count).End(xlUp).Row 'ici la fin de la 3ème colonne
        For I = 2 To Fin
        For J = 3 To 9 Step 2
    
F1.Cells(I, J).Value = .Cells(I, J).Value
Next J
Next I

End With





End Sub
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour Lone-wolf,
Il faudrait déjà que je comprenne ce que vous voulez faire (salut Dranreb ;))

Mais de toute façon en considérant l'instruction:
Select Case Range("a1").CurrentRegion.Column

La région qui entoure la cellule A1 contiendra toujours la colonne 1.
Donc Range("a1").CurrentRegion.Column renverra 1
Donc (en dehors des autres points bizarres), le select ne copiera jamais quoique ce soit.
 
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Bonjour à tous :)

@ Marcel: dans la macro je pense avoir omis la boucle For i ou For each.

@mapomme: j'ai vu sur un post ceci:

For each ws in Worksheets
Select Case ws.name
Case "Feuil3", "Feuil5",Feuil7"
Instruction
End Select
Next Ws

Comme dit dans le post #3: comme copier des colonnes non contigues en utilisant Select Case, dans un tableau qui va de la colonne A à I; parce que d'après ce que j'ai vu sur le Net, select case est plus rapide que la condition If xxx End If quoi que on peut s'en passer (de la condition).
 
Dernière édition:

Lone-wolf

XLDnaute Barbatruc
Re mapomme

À force de tests, j'ai fini par trouvé. Maintenant, comment faire pour n'avoir un seul Case. J'ai essaié avec Case 5, 7, 9, mais sans succès.

VB:
Sub test()
Dim derlig As Long, col As Long, tablo As Range

    Feuil2.Range("a2:c80000").ClearContents

    With Feuil1
        derlig = .Cells(Rows.Count, 1).End(xlUp).Row
        For col = 1 To 9
            Set tablo = .Range(.Cells(2, col), .Cells(derlig, col).Address)

            Select Case col
            Case 5
                tablo.Copy Feuil2.Range("a2:a" & derlig)
            Case 7
                tablo.Copy Feuil2.Range("b2:b" & derlig)
            Case 9
                tablo.Copy Feuil2.Range("c2:c" & derlig)
            End Select

        Next col
    End With

End Sub

en PJ classeur test.
 

Pièces jointes

  • Classeur-Test.xlsm
    20.9 KB · Affichages: 54

Dranreb

XLDnaute Barbatruc
Bonjour.
Ce serait peut être plus simple en bouckant sur la colonne destinatrice, non ?
VB:
Sub test()
Dim Col As Long
Feuil2.Range("a2:c80000").ClearContents
With Feuil1.Rows(2).Resize(Feuil1.Cells(Rows.Count, 1).End(xlUp).Row - 1)
   For Col = 1 To 3
      .Columns(2 * Col + 1).Copy Feuil2.Cells(2, Col)
      Next Col
   End With
End Sub
Mais on peut peut être faire plus simple, sans boucle…
 

Lone-wolf

XLDnaute Barbatruc
Re aaaa t...CHOUM (pardon! :oops:) à toutes et à tous :) :D

Encore une fois, à force de tester. D'accord, je comprend très bien que c'est beaucoup de lignes pour peux de chose :oops:, mais bon...

VB:
Sub test()
Dim derlig As Long, dercol As Long, col As Long
Dim tb1 As Range, tb2 As Range, tb3 As Range

    Application.ScreenUpdating = False
    Feuil2.Range("a2:c80000").ClearContents

    On Error Resume Next
    With Feuil1
        derlig = .Cells(Rows.Count, 1).End(xlUp).Row
        dercol = .Range("a1").End(xlToRight).Column
        For col = 1 To 9
            Set tb1 = .Range(.Cells(2, col - 4), .Cells(derlig, col - 4).Address) 'Colonne E
            Set tb2 = .Range(.Cells(2, col - 2), .Cells(derlig, col - 2).Address) 'Colonne G
            Set tb3 = .Range(.Cells(2, dercol), .Cells(derlig, dercol).Address)   'Colonne I
            Select Case col
            Case tb1, tb2, tb3
                tb1.Copy Feuil2.Range("a2:a" & derlig)
                tb2.Copy Feuil2.Range("b2:b" & derlig)
                tb3.Copy Feuil2.Range("c2:c" & derlig)
            End Select
        Next col
    End With
End Sub

En PJ
 

Pièces jointes

  • Classeur-Test-V2.xlsm
    23.2 KB · Affichages: 46
Dernière édition:

Discussions similaires