Copier/Coller des colonnes de diverses feuilles les unes à la suite

Bonjour à tous

J'espère que vous allez bien,

Alors voilà j'ai un petit soucis, en effet j'aimerai copier/coller toutes les colonnes D des feuilles 1,2 et 3 afin qu'elles se superposent dans la colonne D de la feuille 4. Tout en faisant attention de ne pas copier la ligne 1 de chaque feuille puisque qu'il s'agit d'un titre. Et de même pour la colonne F.

J'avais trouvé se code mais il me sélectionne un ensemble de colonne et non celle que je veux et je suis obligé de toujours le ré écrire et l'assimilé à un bouton pour qu'il refonctionne :

Sub recap()

Dim sh As Worksheet

For Each sh In Worksheets

If sh.Name <> "Recap" Then

sh.[A2].Resize(sh.[A65536].End(xlUp).Row - 1, ''Nombre de colonnes").Copy Destination:=Worksheets("Recap").[A65536].End(xlUp).Offset(1, 0)

End If

Next sh

End Sub

Merci d'avance pour le temps que vous m'accorderez,

Cordialement,

Roijios.

Bonjour Roijio, le forum,

Au plus simple....

Sub recap()
 Dim sh As Worksheet, i%, dl%

 Application.ScreenUpdating = False

    For Each sh In Worksheets
     If sh.Name <> "Recap" Then
      dl = sh.UsedRange.Rows.Count
       sh.Range("D2:D" & dl).Copy Sheets("Recap").Range("D" & Sheets("Recap").Range("D" & Rows.Count).End(xlUp).Row + 1)
       sh.Range("F2:F" & dl).Copy Sheets("Recap").Range("F" & Sheets("Recap").Range("F" & Rows.Count).End(xlUp).Row + 1)
     End If
    Next sh
End Sub

Autre possibilité:

Sub recap2()
 Dim sh As Worksheet, i%, dl%, x%
 Dim tablo, tabloR()

 Application.ScreenUpdating = False

    For Each sh In Worksheets
     If sh.Name <> "Recap" Then
      dl = sh.UsedRange.Rows.Count
      tablo = sh.Range("D2:F" & dl)
     k = 0
      For i = 2 To UBound(tablo, 1)
       ReDim Preserve tabloR(1 To 3, 1 To k + 1)
        For x = 1 To 3
         tabloR(x, 1 + k) = tablo(i, x)
        Next x
     k = 1 + k
      Next i
     End If
     On Error Resume Next
      Sheets("Recap").Range("D" & Sheets("Recap").Range("D" & Rows.Count).End(xlUp).Row + 1).Resize(UBound(tabloR, 2), 3) = Application.Transpose(tabloR)
     Erase tablo: Erase tabloR
    Next sh
End Sub

Cordialement,

Bonjour @xorsankukai

Merci beaucoup pour votre réponse, malheureusement pour le programme "recap" j'ai un problème ici :

Je suis désolé mais j'ai oublié de préciser une condition, en effet le programme doit tourner uniquement sur trois feuilles nommées : "TMI", "TSA" et "TUS".

Merci d'avance pour vos réponses,

Roijios.

Re,

Merci pour le retour,

Un autre essai....

J'ai testé avec

dl = sh.UsedRange.Rows.Count

Ça fonctionne également....

Cordialement,

@xorsankukai

Re,

Merci beaucoup de ce que vous faites pour ce forum, ça marche au poil.

Bonne journée/soirée à vous !!

Roijio.