probleme de memorisation des valeurs prisent lors d'une boucle Résolu/Fermé

Question

Bonjour, 
.
.
voici mon probleme, je souhaite copier les valeurs d'une feuille en ne prenant qu'une ligne sur deux et cela sur 6 colonnes, vers une seconde feuille.
.
je l'ai fais en selectionnant cellule par cellule mais l'exécution et longue, j'aimerais donc le faire par plage de cellules mais du fait que je ne prend qu'une ligne sur deux, les plages ne sont pas continues.
.
voici mon code:
(la selection ne se fait pas et je pense que le probleme vient du fait que "lignesurdeuxtotal = Array(lignesurdeux)" ne prend que la dernière valeur de la boucle)
.
.
.
.
'préparation des variable utiles au "copier/coller" feuille1/feuille2
.
'nombre de colonne
    nbcolonne = 6
.    
'numero de la dernière ligna à prendre
    lignesurdeuxfin = 7500
.
'"copier/coller" "copier/coller" d'une ligne sur deux de feuille1 vers feuille2 
    For i = 1 To nbcolonne
.       
    'boucle pour lignesurdeux
.
        For j = 1 To lignesurdeuxfin
.        
        Dim k As Integer
        Dim maselection As Range
        Dim lignesurdeuxtotal
.        
        lignesurdeux = 17 + j * 2
.
        lignesurdeuxtotal = Array(lignesurdeux)
.
.    
    Set maselection = Sheets("feuille1").Cells(lignesurdeuxtotal(0), i)
.    
     Next j
    'fin boucle lignesurdeux
.        
    'boucle selection
.
    '"ubound" renvoi à la dernière valeur du Array de "lignesurdeuxtotal"
        For k = 1 To UBound(lignesurdeuxtotal)
.        
        Set maselection = Application.Union(maselection, Cells(lignesurdeuxtotal(k), i))
.        
.        
        Next k
    'fin boucle selection
.  
.    
   'maselection.Select
.
.        
            Sheets("feuille1").maselection.Copy _
            Destination:=Sheets("feuille2").Cells(1, i)
.                          
.    
    Next i
'fin de boucle colonnes
.
.
auriez vous une methode pour que toutes les valeurs prisent par "lignesurdeux" soit mémorisées?
.
(exemple: lignesudeuxtotal=array(lignesurdeux1,lignesurdeux2,lignesurdeux3...)
.
merci à vous chers internautes :)


Configuration: Windows 8 / Chrome 27.0.1453.110

f894009 · Answer

Bonjour,

Copie d'une ligne sur deux feuil1 vers feuil2 colonne A a F: adaptez les colonnes

Option Base 1
Sub copie_1_sur_2()
    Dim Plage, tableau()
    
    'mise en memoire plage de donnees a traiter: adapter la plage
    Plage = Worksheets("feuil1").Range("A1:F7500").Value
    'init pointeur de tableau
    s = 0
    'longueur du tableau
    finTableau = UBound(Plage) / 2
    'dimensionnement tableau
    ReDim tableau(finTableau, 6)
    'ecriture du tableau avec valeur de ligne, une ligne sur deux
    For x = 1 To 7500 Step 2
        s = s + 1
        tableau(s, 1) = Plage(x, 1)
        tableau(s, 2) = Plage(x, 2)
        tableau(s, 3) = Plage(x, 3)
        tableau(s, 4) = Plage(x, 4)
        tableau(s, 5) = Plage(x, 5)
        tableau(s, 6) = Plage(x, 6)
    Next x
    'ecriture feuil2
    Worksheets("feuil2").Range("A1:F" & finTableau) = tableau()
End Sub

bonne suite

biftake · Answer

merci beaucoup !

Probleme de memorisation des valeurs prisent lors d'une boucle

2 réponses

Discussions similaires