VBA-Repeter une action plusieurs fois entre deux feuilles

Bonjour!

J'ai besoin de votre aide urgemment; voilà:

J'ai des données disposée horizontalement dans une feuille.

J'aimerais copier chaque ligne horizontale dans une autre feuille sous une autre disposition verticale

J'en ai une tonne et je voudrais créer un script VBA pour cela. Je ne m'y connais pas en programmation, j'ai besoin de votre aide.

Voici la macro que j'ai enregistré pour 2 lignes:

Sub Macro2()

'

' Macro2 Macro

'

'

Sheets("9439014").Select

Range(Selection, Selection.End(xlToRight)).Select

Selection.Copy

Sheets("Feuil2").Select

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=True

Selection.End(xlDown).Select

Range("B32").Select

Sheets("9439014").Select

ActiveWindow.ScrollColumn = 8

ActiveWindow.ScrollColumn = 7

ActiveWindow.ScrollColumn = 6

ActiveWindow.ScrollColumn = 5

ActiveWindow.ScrollColumn = 4

ActiveWindow.ScrollColumn = 3

ActiveWindow.ScrollColumn = 2

ActiveWindow.ScrollColumn = 1

Range("D5").Select

Range(Selection, Selection.End(xlToRight)).Select

Application.CutCopyMode = False

Selection.Copy

Sheets("Feuil2").Select

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _

False, Transpose:=True

End Sub

Pouvez-vous m'aider à répéter l'action de : copier une à une les plages de données horizontale de la feuille "9439014" et coller verticalement (la transposée) sur une colonne de la deuxième feuille, ainsi de suite jusqu'à la dernière ligne de la feuille de destination.

Merci d'avance!!!

La feuille excel en pièce jointe

Bonjour et bienvenue sur le forum

Un essai à tester. Te convient-il ?

Bye !

Bonsoir wendso, gmb,

pas compris la même chose et... encore moins sûr d'avoir même compris...

Private Sub Worksheet_Activate()
'
Dim tData
'
tData = Worksheets("9439014").UsedRange.Value
Range("A1").Resize(UBound(tData, 2), UBound(tData, 1)) = WorksheetFunction.Transpose(tData)
'
End Sub

A+

@ Curulis

Qui a tort ?

Qui sera remercié ?

Suspense !

Bye !

Salut gmb,

faudra songer à organiser des paris... ou des tournées!

A+

Bonjour Wendso gmb, curulis57

Quant à moi je serais plus dans l'esprit de gmb avec une légère variante dans l'écriture (chacun son style)

Sub Recap()
Dim tabDatas()
Dim tabRecap()

Dim wsDatas As Object
Dim wsRecap As Object

Dim cptDatas, colDatas
Dim nbrRecap

    Set wsDatas = Worksheets("9439014")
    Set wsRecap = Worksheets("RECAP")

    With wsDatas
        tabDatas = Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, .Cells(Columns.Count).End(xlToLeft).Column))
    End With

    nbrRecap = 1
    ReDim tabRecap(1 To 2, 1 To nbrRecap)
    For cptDatas = 1 To UBound(tabDatas, 1)
        For colDatas = 4 To UBound(tabDatas, 2)
            ReDim Preserve tabRecap(1 To 2, 1 To nbrRecap)
            tabRecap(1, nbrRecap) = DateSerial(tabDatas(cptDatas, 2), tabDatas(cptDatas, 3), colDatas - 3) * 1
            tabRecap(2, nbrRecap) = tabDatas(cptDatas, colDatas)
            nbrRecap = nbrRecap + 1
        Next
    Next

    With wsRecap
        Range(.Cells(2, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 2)).ClearContents
        .Cells(2, 1).Resize(UBound(tabRecap, 2), UBound(tabRecap, 1)) = WorksheetFunction.Transpose(tabRecap)
    End With

    Set wsDatas = Nothing
    Set wsRecap = Nothing

End Sub

juste histoire de faire grossir les paris