Copier colonne de quatre feuille sur autre une feuille

Bonjour,

Je vous explique ce que j'essaie de faire. J'ai un fichier avec 4 feuilles :

trans_text avec des données en colonne "E5",

trans_Path avec des données en colonne "D5",

trans_lien avec des données en colonne "F5" et

trans_list avec des données en colonne "F5".

Chacune de ces feuilles dispose d'informations différentes.

Je voudrais coller ces colonnes dans la feuille "Recap " dans une colonne à la suite.

J'ai fait ceci mais sa ne marche pas?

Private LigVid As Long

Private DL As Integer

Private Tampon

Sub Compiler_BaT()

Application.ScreenUpdating = False

On Error Resume Next

With Sheets("recap")

Cells.ClearContents

End With

With Sheets("trans_text")

DL = .Columns("E5").Find(what:="*", searchdirection:=xlPrevious).Row

Tampon = .Range("E5" & DL)

End With

Recopie

With Sheets("trans_Patch")

DL = .Columns("D5").Find(what:="*", searchdirection:=xlPrevious).Row

Tampon = .Range("D5" & DL)

End With

Recopie

With Sheets("Trans_Lien")

DL = .Columns("f5").Find(what:="*", searchdirection:=xlPrevious).Row

Tampon = .Range("F5" & DL)

End With

Recopie

With Sheets("Trans_List")

DL = .Columns("E5:F5").Find(what:="*", searchdirection:=xlPrevious).Row

Tampon = .Range("F5" & DL)

End With

Recopie

End Sub

Sub Recopie()

On Error Resume Next

With Sheets("recap")

LigVid = .Columns("f").Find(what:="*", searchdirection:=xlPrevious).Row + 1

If LigVid = 0 Then LigVid = 1

Cells(LigVid, "B").Resize(UBound(Tampon), 6) = Tampon

End With

End Sub

Je ne sais pas si je suis très clair.

Je vous joins le fichier pour l'exemple :

Je vous remercie d"avance

Max

Salut Valmax, Salut le Forum,

Il y a pas mal de chose qui ne vont pas dans tes codes :

 With Sheets("trans_text")

Trans_text n'est pas le nom de ta feuille

.Columns("E5")
.Columns("D5")
.Columns("f5")

Sa ne fonctionne pas sa en VBA

LigVid = .Columns("f").Find(what:="*", searchdirection:=xlPrevious).Row + 1

Si tu veux chercher la dernière ligne vide d'une colonne (ici F) utilise plutôt :

LigVid = Range("F" & Rows.Count).End(xlUp).Row + 1

Si tu a d'autre question reviens vers nous

bonjour,

proposition de correction

Private LigVid As Long
Private DL As Integer
Private Tampon

Sub Compiler_BaT()
    Application.ScreenUpdating = False
    With Sheets("recap")
        .Cells.ClearContents
    End With
    With Sheets("trans_texte")
        DL = .Cells(Rows.Count, "E").End(xlUp).Row
        Tampon = .Range("E5:E" & DL)
    End With
    Recopie
    With Sheets("trans_Path")
        DL = .Cells(Rows.Count, "D").End(xlUp).Row
        Tampon = .Range("D5:D" & DL)
    End With
    Recopie
    With Sheets("Trans_Lien")
        DL = .Cells(Rows.Count, "F").End(xlUp).Row
        Tampon = .Range("F5:F" & DL)
    End With
    Recopie
        With Sheets("Trans_List")
        DL = .Cells(Rows.Count, "F").End(xlUp).Row
        Tampon = .Range("E5:F" & DL)
    End With
    Recopie
End Sub

Sub Recopie()
    With Sheets("recap")
        LigVid = .Cells(Rows.Count, "B").End(xlUp).Row + 1
        If LigVid = 0 Then LigVid = 1
        .Cells(LigVid, "B").Resize(UBound(Tampon, 1), UBound(Tampon, 2)) = Tampon
    End With
End Sub

Bonjour h2so4

Je te remercie mais une erreur sur cette ligne.

Incompatibilité de type

.Cells(LigVid, "B").Resize(UBound(Tampon, 1), UBound(Tampon, 2)) = Tampon

@+

Max

Bonjour,

voici le code modifié, dans ton classeur et qui fonctionne.

Re-

Une autre manière de procéder :

Sub Copy_Paste()
Dim x As Long, y As Long, e As Long, f As Long, q As Long
Dim a As Range, b As Range
Dim p As String, Col As String
x = Worksheets.Count
For y = 1 To x - 1
    Set b = Sheets(y).Cells
    Set a = b.Cells.Find(What:="*")
    p = a.Address
    q = a.Column
    Col = Split(Columns(q).Address(ColumnAbsolute:=False), ":")(1)
    e = Sheets(y).Range(Col & Rows.Count).End(xlUp).Row
    Sheets(y).Range(p & ":" & Col & e).Copy
    f = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row + 1
    Range("A" & f).Select
    ActiveSheet.Paste
Next
Cells(1, 1).Select
End Sub

En te mettant sur ta feuille récap, la plus à droite

Salut Juice

Je te remercie Nickel

Bonne journée

Max