Transposer des valeurs de plusieurs feuilles vers une feuille synthèse

Bonjour à tous,

Suite à divers conseils, j'ai réorganisé tous mes tableaux et d'y appliquer l'objet "range" pour simplifier mais je n'arrive vraiment pas à transposer mes données dans la feuille draft.

Sur toutes les feuilles, hors draft et source, les colonnes A à I, doivent se transposer dans les colonnes C à K de la feuille "Draft", le tout en cliquant sur le bouton "importer" de la feuille "draft". J'ai aussi utiliser une fonction "nettoyer" pour supprimer et recoller le tout à chaque clic sur "importer".

J'entends que cela doit être relativement simple, mais j'ai beau tenter divers codes, je n'y arrive pas.

Je vous joins le fichier, et suis à l'écoute de vos conseils.

Merci.

Bonjour

Au vu du fichier et pour faire simple, on peut utiliser simplement les codes suivants :

1. Nettoyer

Sub Nettoyer()
Dim DlgD As Integer
With Sheets("Draft")
    DlgD = .Range("E" & .Rows.Count).End(xlUp).Row
    If dlgD = 10 Then Exit Sub
    .Range("C11:K" & DlgD).ClearContents
End With
End Sub

2. Importer

Sub Importer()
Dim Ws As Worksheet
Dim DlgS As Integer, DlgD As Integer

Application.ScreenUpdating = False
Call Nettoyer

For Each Ws In ThisWorkbook.Sheets
    DlgS = Ws.Range("C" & Ws.Rows.Count).End(xlUp).Row
    DlgD = Sheets("Draft").Range("E" & Sheets("Draft").Rows.Count).End(xlUp).Row + 1
    If Ws.Name <> "Draft" And Ws.Name <> "Source" Then
    Ws.Range("A2:I" & DlgS).Copy
    Sheets("Draft").Range("C" & DlgD).PasteSpecial Paste:=xlPasteValues
End If
Next Ws
Application.ScreenUpdating = True
End Sub

ou celle-ci (plus rapide)

Sub Importer()
Dim tablo()
Dim Ws As Worksheet
Dim DlgS As Integer, dlgD As Integer, i as Integer, j as Integer

Application.ScreenUpdating = False
Call Nettoyer
For Each Ws In ThisWorkbook.Sheets
    DlgS = Ws.Range("C" & Ws.Rows.Count).End(xlUp).Row
    If Ws.Name <> "Draft" And Ws.Name <> "Source" Then
        ReDim tablo(DlgS - 2, 9)
        j = 0
        For i = 0 To DlgS - 2
            For j = 0 To 9
                tablo(i, j) = Ws.Cells(i + 2, j + 1)
            Next j
        Next i
        dlgD = Sheets("Draft").Range("E" & Sheets("Draft").Rows.Count).End(xlUp).Row + 1
        Sheets("Draft").Range("C" & dlgD & ":K" & dlgD).Resize(UBound(tablo) + 1) = tablo
    End If
Next Ws
Application.ScreenUpdating = False
End Su

Ensuite affecter le bouton se trouvant sur la feuille DRAFT au code Importer.

Cordialement

Bonjour

Bonjour à tous

Un autre essai

Bye !

Merci vraiment à tous, c'est exactement ce que je souhaitais effectuer; je vais essayer de les comprendre maintenant :)

Bonne journée.