VBA à corriger

Bonjour à tous

je cherche à compiler plusieurs onglets sous un meme onglet en mettant à la suite les données récupérées sur chaque feuille.

le nombre de ligne peut varier d'une feuille à l'autre mais les colonne sont fixe : de A à H . de plus les cellules à copier démarrent toujours en A15.

Voici la macro que j'ai faite mais je ne comprend pas pourquoi dans mon onglet "RECAP" au final je n'ai que les valeurs de la première feuille qui se répètent autant de fois à la suite que j'ai de feuille. Au lieu de copier et coller les ligne de chaque feuille..

Ou se trouve mon erreur ?

merci a tous

Sub Recup()

Dim sht As Worksheet

For Each sht In ThisWorkbook.Worksheets
    If sht.Name <> "RECAP" Then
        With sht
            Range("A15").Select
                    Range(Selection, Selection.End(xlToRight)).Select
                           Range(Selection, Selection.End(xlDown)).Copy

        Sheets("RECAP").Cells(Rows.Count, "A").End(xlUp)(2).PasteSpecial _
              Paste:=xlValues

        End With
    End If

Next sht

End Sub

Bonjour,

Essaie ceci :

Sub Recup()
    Dim sht As Worksheet, plge As Range, n%, k%, i%
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name <> "RECAP" Then
            With sht.Range("A15")
                k = .End(xlToRight).Column
                n = .End(xlDown).Row
                Set plge = .Resize(n - 14, k)
            End With
            With Worksheets("RECAP")
                i = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                .Cells(i, 1).Resize(n - 14, k).Value = plge.Value
            End With
        End If
    Next sht
End Sub

Bonjour,

Ou essaie ainsi :

Sub Recup()
Dim sht As Worksheet, sht2 As Worksheet
Dim rng As Range
Dim lastRow As Long, lRow As Long

    Application.ScreenUpdating = False

    Set sht2 = ActiveWorkbook.Worksheets("RECAP")
    lRow = 1
    'lRow = sht2.Cells(Rows.Count, 1).End(xlUp).Row + 1
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name <> sht2.Name Then
            With sht
                lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
                Set rng = .Range("A15:H" & lastRow)
                rng.Copy Destination:=sht2.Cells(lRow, 1)
                lRow = sht2.Cells(Rows.Count, 1).End(xlUp).Row + 1
            End With
        End If
    Next sht

    Set rng = Nothing: Set sht2 = Nothing

End Sub

merci pour vos propositions

MFREAND : ta macro bloque à ce niveau : n = .End(xlDown).Row

JEAN ERIC : j'ai a peu pres ce que je souhaite mais je peux me debrouiller avec ça

Merci à vous

j'ai une demande complémentaire...

pouvez vous ajouter dans le code de quoi insérer en première colonne les trois derniers caractères de l'intitulé de chaque onglet ?

en gros pour autant de ligne que comprend la feuille à recopier il faudrait dans l'onglet "RECAP" mettre en première colonne le nom de l'onglet ( les derniers caractères) dont elles sont issues.

merci encore

C'est que ton choix de xlDown était erroné (par exemple la cellule A16 est vide !)... Rien de grave puisque la macro de Jean-Eric (qui a fait le même calcul avec xlUp) fonctionne., tu peux poursuivre.

désolé je ne suis pas expert, je n'ai fais que récupérer et bidouiller ce que j'avais trouvé sur des forums.

Une proposition pour ma question complémentaire ?

merci

Bonjour,

Nous comprenons que tu ne sois pas un expert, je ne suis pas moi même.

Mais que cela ne t'empêche pas de joindre un fichier à ta demande.

Cdlt.

si cela peux aider voici un petit exemple...

Bonjour,

Voir fichier.

Tu aurais pu uniformiser tes tableaux, éviter les cellules fusionnées, etc...

Maintenant il faudrait connaître l'objectif final de la chose...

Cdlt.