XL pour MAC Copier coller une plage de valeurs n fois

[JayBee]

Bonjour,

J'ai cherché sur le forum mais n'ai pas trouvé de réponse, ma demande est un peu particulière.
Je voudrais copier / coller une plage de valeurs n fois, en ajoutant une colonne reprenant les différentes valeurs.

voilà mon exemple, ça sera plus facile à expliquer :
- Feuil1: J'ai une liste de 4 "pays de destination", avec pour chacun un montant et une devise correspondante. Cela correspond aux indemnités journalières reçues par les employés voyageant dans ce pays.
- Feuil2: Cette liste doit être copiée et collée depuis la Feuil1 vers la Feuil2 autant de fois qu'il y a de pays (ici 4 fois). Les valeurs doivent être copiées les unes en desosus des autres.
- Feuil2: une colonne doit être ajoutée en 1er (colonne A), avec le "pays du voyageur". Il faut pour cela reprendre chaque pays de la liste d'origine. Pour le 1er pays "Afganistan", on copie / colle toutes les valeurs, pour le 2eme pays "Albania" idem, etc...

Le cas réel comprend plus de 120 valeurs, ça fait pas mal de copié / collé!

Si quelqu'un a la solution, ça doit être faisable en VBA mais je n'ai pas réussi à le faire pour le moment (je suis débutant comme vous pouvez imaginer).
Un grand merci pour votre aide, et une très bonne année!

 

[laurent950]

Bonjour @JayBee

Sub Test()
Dim T As Variant
T = Feuil1.Range(Feuil1.Cells(1, 2), Feuil1.Cells(Feuil1.Cells(65536, 2).End(xlUp).Row, 7))
Copie T
End Sub

Sub Copie(ByRef T As Variant)
Dim pos As Double
Feuil2.Cells.ClearContents
If Feuil2.Cells(65536, 2).End(xlUp).Row = 1 Then pos = 0 Else pos = Feuil2.Cells(65536, 2).End(xlUp).Row
Dim i As Integer
    For i = LBound(T, 1) To UBound(T, 1)
        For j = LBound(T, 1) To UBound(T, 1)
            Feuil2.Cells(pos + j, 1) = T(i, 1)
        Next j
            Feuil2.Cells(pos + 1, 2).Resize(UBound(T, 1), UBound(T, 2)) = T
            pos = Feuil2.Cells(65536, 2).End(xlUp).Row
    Next i
End Sub

 

[sylvanu]

Bonjour JayBee,
Un essai en PJ avec :

Sub Transfert()
Dim tablo(), tablo2(), N%, DL%, L1%, L2%, C%
Application.ScreenUpdating = False
DL = Sheets("Feuil1").Range("B65500").End(xlUp).Row
tablo = Range("A1:G" & DL)
N = UBound(tablo) ^ 2
ReDim tablo2(N, 7)
For L1 = 1 To UBound(tablo)
    For L2 = 1 To UBound(tablo)
        C = DL * (L1 - 1) + L2 - 1
        tablo2(C, 0) = tablo(L1, 2)
        tablo2(C, 1) = tablo(L2, 2)
        tablo2(C, 4) = tablo(L2, 5)
        tablo2(C, 5) = tablo(L2, 6)
        tablo2(C, 6) = tablo(L2, 7)
    Next L2
Next L1
Sheets("feuil2").Cells.ClearContents
Sheets("feuil2").Range("$A$1").Resize(UBound(tablo2, 1) + 1, UBound(tablo2, 2) + 1) = tablo2
End Sub

 

[JayBee]

Merci beaucoup pour vos retours!