Recopier valeurs en décalant d'une ligne

bonjour,

j'essaye de goupiller ce code depuis cet aprem sans succès, merci de m'aider svp et surtout m'indiquer pourquoi ça ne marche pas.

je cherche à recopier les valeurs de la colonne de A2 jusqu'à la dernière ligne non vide vers K à partir de la ligne 3 en décalant d'une ligne vers le bas à chaque fois.

merci.

Bonjour,

à tester,

Sub test()
Dim tbl()
Set Source = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
For i = 1 To Source.Count
   n = n + 2
    ReDim Preserve tbl(n)
    tbl(n - 1) = Source(i)
    tbl(n) = ""
Next
Range("K2").Resize(UBound(tbl)) = Application.Transpose(tbl)
End Sub

Salut Moutchec,

Salut Isa,

• tant qu'à utiliser Application.ScreenUpdating = True en fin de code... place son pendant au début : Application.ScreenUpdating = False
• déclare tes variables avec leur type, sinon, c'est = Variant !

* Dim source as Range. Comme tu l'avais écrit, cela pouvait désigner un tableau !

• pour initialiser une Range, il faut écrire Set source = ...
• pour affecter des valeurs à une autre cellule ou plage, affectation directe : oublie les Select, Copy... dans ce cas précis, évidemment.
• pour calculer la hauteur exacte d'une colonne de valeur : Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
• j'ai trié la colonne en ordre décroissant, que tu t'aperçoives de quelque chose, les données en [A] étant déjà triées ;
• à la lecture, tu cherches à insérer une ligne sur deux dans [K]. Il faut alors remonter la colonne, sinon, catastrophe!

Imagine-le dans le sens inverse et, mentalement (bel exercice ), calcule les valeurs de lignes d'une boucle à l'autre !

Private Sub CommandButton1_Click()
'
Dim iRowK%
'
Application.ScreenUpdating = False
'
Range("K3:K" & Range("A" & Rows.Count).End(xlUp).Row + 1).Value = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
iRowK = Range("K" & Rows.Count).End(xlUp).Row
Range("K2:K" & iRowK).Sort Key1:=Range("K2"), order1:=xlDescending, Orientation:=xlSortColumns
'
For x = iRowK To 4 Step -2
    Range("K" & x).Insert shift:=xlDown
    x = x + 1
Next
Application.ScreenUpdating = True
'
End Sub

bonjour le formun,

bonjour @curulis57,

merci pour ces précieux tuyaux.

merci à tous.