Macro qui ne fonctionne pas

Bonjour,

J'ai un fichier avec une macro qui ne fonctionne pas.

N'ayant pas les compétences pour la créer, j'en ai trouvé une que j'ai mise dans mon fichier, je l'ai modifié, mais en vain.

Elle devrait prendre les données de mes pages Base_1, base_2, Base_3 pour les mettre dans la page Recap.

Pouvez vous me dire ou se trouve mon erreur?

Merci

Bonsoir,

En supprimant ton Tableau (en le mettant en plage) voici un code

Sub Compiler()
Dim f

    'On met les tableau à la suite
    For Each f In Worksheets
        If f.Name <> ActiveSheet.Name Then
            f.Range("A4:c" & f.Range("A" & Rows.Count).End(xlUp).Row).Copy _
            Range("A" & Range("A" & Rows.Count).End(xlUp)(2).Row)
        End If
    Next f
     'On efface les doublons
    Range("A4:c" & Range("A" & Rows.Count).End(xlUp).Row).RemoveDuplicates Columns:=Array(1, 2, 3), _
        Header:=xlYes

    'On trie les noms par ordre alphabétique
    Range("A4:c" & Range("A" & Rows.Count).End(xlUp).Row).Sort key1:=Range("A4"), Order1:=xlAscending, Header:=xlNo
End Sub
    

Merci ça fonctionne à merveille.

Mais j'ai deux soucie.

Je voudrais ne pas mettre toutes mes pages dans mon tableau Recap, que certaine, donc je voudrais les sélectionné comme dans mon code qui ne fonctionnait pas

Select Case s.Name
    Case "Base_1", "Base_2", "Base_3"

Deuxième soucie, quand je supprimes des lignes dans mes tableaux Base_1, base_2, elles ne suppriment pas dans mon tableau Recap, j'en ai même en double

Bonjour,

Une autre proposition à étudier.

Cdlt.

Bonsoir,

Une autre proposition

Sub mlk()
Application.ScreenUpdating = False
Sheets("Recap").Range("A4:C6000").ClearContents
ligne = 0

For Each S In Worksheets
    Select Case S.Name
    Case "Base_1", "Base_2", "Base_3"
    Sheets(S.Name).Activate
        derligne = Range("A" & Rows.Count).End(xlUp).Row
        For i = 1 To derligne - 3
            For j = 0 To 2
                Sheets("Recap").Range("a4").Offset(ligne, j) = S.Range("a4").Offset(i - 1, j)
            Next j
        ligne = ligne + 1
        Next i
    End Select

Next S
Sheets("Recap").Activate
Application.ScreenUpdating = True
End Sub

Vos propositions Jean-Eric et Robjam fonctionnent à merveille et c'est tout à fait ce que je cherchais.

Merci beaucoup à vous