Transférer valeur de plusieurs colonnes dans un tableau les une à la suite

Salut à tous les membres de la communauté.

J'ai un gros soucis avec un code vba adapté à mon Fichier. Le code devrait me permettre de copier les données dans les feuil2, 3 et 4 de mon classeur pour les coller dans la feuil("BILAN"), les une à la suite des autres (sur la dernière ligne).

Le problème :

Quand je copie et je colle les données de la feuill2 sur mon tableau dans la feuille ("BILAN"), tout marche correctement.

mais quand je copie les données de la feuil3 pour les mettre à la suite de mon tableau, ça ne marche pas. Les données s'écrasent. Et je perds les données de la feuil2 au profit de celle de la feuil3 et ainsi de suite.

A la fin de l'exécution du code, je me retrouve avec uniquement les données copiées dans la dernière feuille de mon classeur.

je demande donc l'aide de tous.

merci.

fichier joint avec ma macro à l'intérieur

Bonjour,

Tu ne change pas de ligne dans Bilan quand tu inscrit des données. (Tu reste sur 6)

Essai ça : (LigTab = ligne 5 + nombre ligne tu tableau "BILAN")

Sub resumé()
    Dim PremièreLigne As String
    Dim dernièreLigne As String
    Dim shts As Worksheet
    Dim BL As Worksheet
    Dim plage As Range
    Dim Feuille As Range

Set BL = Worksheets("BILAN")
With BL.ListObjects(1)
    If Not BL.ListObjects(1).DataBodyRange Is Nothing Then
        BL.ListObjects(1).DataBodyRange.Delete
        If .ListRows.Count = 0 Then .ListRows.Add: lig = 1
        Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
    End If
End With
Set plage = ThisWorkbook.Worksheets("ADMIN").Range("A1:A3")
LigTab = 5 + BL.ListObjects(1).ListRows.Count
For Each Feuille In plage
    With Sheets(Feuille.Value)
        BL.Range("B" & LigTab).Resize(1, 25).Value = .Range("A3:Y3").Value
        BL.Range("AA" & LigTab).Value = .Range("E4").Value
        BL.Range("AB" & LigTab).Value = .Range("F4").Value
        BL.Range("AC" & LigTab).Value = .Range("M4").Value
        BL.Range("AD" & LigTab).Value = .Range("N4").Value
        LigTab = LigTab + 1
    End With
Next Feuille
End Sub

A+

Salut, Goef52.

j'ai essayé mais ça ne change toujours pas.

C'est pas ce resultat que tu souhaites ?

Change tout le code pas juste la ligne "LigTab"

Bonjour,

Le code me rappelle quelque chose...
Une autre idée comme ceci :

Sub resumé()
Dim BL As Worksheet
Dim plage As Range
Dim Feuille As Range
Dim lig As Byte

Set BL = Worksheets("BILAN")
With BL.ListObjects(1)
    If Not .DataBodyRange Is Nothing Then
        .DataBodyRange.Delete
    End If
End With

Set plage = ThisWorkbook.Worksheets("ADMIN").Range("A1:A3")
For Each Feuille In plage
    With BL.ListObjects(1)
        If .ListRows.Count = 0 Then
            .ListRows.Add: lig = 1
        Else: .ListRows.Add: lig = .ListRows.Count 'insérer à la dernière ligne
        End If
    End With

    With Sheets(Feuille.Value)
        BL.ListObjects(1).DataBodyRange(lig, 1).Resize(1, 25).Value = .Range("A3:Y3").Value
        BL.ListObjects(1).DataBodyRange(lig, 26).Value = .Range("E4").Value
        BL.ListObjects(1).DataBodyRange(lig, 27).Value = .Range("F4").Value
        BL.ListObjects(1).DataBodyRange(lig, 28).Value = .Range("M4").Value
        BL.ListObjects(1).DataBodyRange(lig, 29).Value = .Range("N4").Value
    End With
Next Feuille
End Sub

Cordialement

Geof52,

C'est exactement ce résultat que je cherche.

j'ai tout changé, ça marche bien.

Merci également à DAN. c'est justement un de vos code que j'essai d'adapter.

la proposition que vous aviez faite marche aussi.

merci à tout le monde.