VBA Copie puis coller dans une autre feuille avec espace

Bonsoir le forum

J'aimerai pouvoir copier puis coller dans une autre feuille en mettant un espace de 2 lignes, Mais pas en insérant 2 lignes.

1- Feuille "DATA" copie de "D9, jusqu’à la dernière ligne non vide.

2- Feuille "ADMINISTRATEUR" Coller à partir "C30 tout les 3 lignes , j'ai mis en couleur jaune le résultat que je souhaiterais et en vert les espaces.

Sur la droite il y a un histogramme barre 2D (Je n'ai mis qu'une représentation de l'ordonnée)

Le but est que par la suite quand je clic sur par exemple "Tbl_1-Ligne3 -> je vais ouvrir la feuille correspondante.

Je n'ai mis que 3 feuilles , mais mon projet en comporte beaucoup plus.

En espérant que la description soit compréhensible de tous.

Merci de votre aide

Bonne soirée au Forum

Re le forum

En parcourant le site, j'ai trouvé un code de pierreCT31, que je ai compris partiellement.

En essayant sur un autre fichier, j'ai réussi à faire cela.

Sub copypasteespace()

Dim i As Integer

Range("A1").Activate

For i = 1 To 7

Cells(i, 1).Copyhttps://forum.excel-pratique.com/post/repondre/168249#

Cells(3 * i - 2, 2).PasteSpecial Paste:=xlValue

Next

End Sub

Suis je sur la bonne voie

il reste la partie derlign que je ne maitrise pas du tout

A bientôt

Bonsoir Ledzep, bonsoir le forum,

Essaie comme ça :

Sub Macro1()
Dim OD As Worksheet 'déclare la variable OD (Onglet Data)
Dim OA As Worksheet 'déclare la variable OA (Onglet Administrateur)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TD As Variant 'déclare la variable TD (Tableau Data)
Dim TA() As Variant 'déclare la variable TA (Tableau Administrateur)
Dim I As Integer 'déclare la variable I (Incrément)
Dim K As Integer 'déclare la variable K (incrément)

Set OD = Worksheets("DATA") 'définit l'onglet OD
Set OA = Worksheets("ADMINISTRATEUR") 'définit l'onglet OA
DL = OA.Cells(Application.Rows.Count, "C").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne C de l'onglet OA
OA.Range("C30:C" & DL).ClearContents 'efface les ancienne valeurs de l'onglet OA
TD = OD.Range("D6").CurrentRegion 'définit le tableau TD
For I = 4 To UBound(TD, 1) 'boucle sur toutes les lignes I du tableau TD (en partant de la quatrième)
    K = K + 3 'incrémente k par pas de 3
    ReDim Preserve TA(1 To K) 'redimensionne le tableau TA
    TA(K - 2) = TD(I, 1) 'récupère la donnée ligne I colonne 1 de TD dans le tableau TA
    'les valeurs TA(K-1) et TA(K) restent vides
Next I 'prochaine ligne de la boucle
OA.Range("C30").Resize(K, 1) = Application.Transpose(TA) 'renvoie le tableau TA transposé dans la cellule C30 redimensionnée de l'onglet OA
End Sub

Bonsoir le forum

Merci ThauThème ton code fonctionne , et avec les commentaires

j'ai analysé la manière dont tu as utilisé DL dernière ligne, je commence à comprendre le principe.

Je vais clore le sujet quand je l'aurais mis dans mon projet. (coupure de courant ce jour)

Bonne soirée à toi et au forum.

A bientôt