Selectionner une ligne sur 2 Excel VBA
Fermé
steph4
-
23 nov. 2015 à 04:24
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 - 23 nov. 2015 à 08:51
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 - 23 nov. 2015 à 08:51
A voir également:
- Selectionner une ligne sur 2 Excel VBA
- Aller à la ligne excel - Guide
- Liste déroulante excel - Guide
- Calculer une moyenne sur excel - Guide
- Déplacer une colonne excel - Guide
- Si et excel - Guide
1 réponse
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 306
Modifié par michel_m le 23/11/2015 à 08:57
Modifié par michel_m le 23/11/2015 à 08:57
Bonjour
proposition
la maquette de W
http://www.cjoint.com/c/EKxh1vpKooa
Michel
proposition
Option Explicit
Option Base 1
'colonnes concernées pour éviter de copier 16384 colonnes....
Const Col_deb As Byte = 1 'colonne A à adapter
Const Col_fin As Byte = 4 'colonne D à adapter
'---------------------------------------------
Sub copier_1sur2()
Dim Derlig As Long, T_in, T_out
Dim Lig As Integer, Col As Byte, Idx As Integer
'---------------initialisation
Application.ScreenUpdating = False
With Sheets(1)
'mémorisation tableau initial
Derlig = .Columns(Col_deb).Find(what:="*", searchdirection:=xlPrevious).Row
T_in = .Range(.Cells(3, Col_deb), .Cells(Derlig, Col_fin))
End With
'préparation tableau 1/2
ReDim T_out(Int(Derlig / 2) - 1, Col_fin - Col_deb + 1)
'---------------------traitement
For Lig = 1 To UBound(T_in) Step 2
Idx = Idx + 1
For Col = Col_deb To Col_fin
T_out(Idx, Col) = T_in(Lig, Col)
Next
Next
'---------------------restitution
With Sheets(2)
.Range("A2").Resize(UBound(T_out), Col_fin - Col_deb + 1) = T_out
.Activate
End With
End Sub
la maquette de W
http://www.cjoint.com/c/EKxh1vpKooa
Michel