XL 2016 Copy

[Bebzinda]

Bonjour a tous! J'aimerais copier des lignes renseignées dans différente feuille et les coller dans une autre feuille. Je n'y arrive pas. J'ai fortement besoin d'aide. Merci et excellente journée !

 

[cp4]

Re,

J'ai fait un petit effort. La macro se déclenche à l'activation de la feuille synthèse.
Si tu veux que le rendu soit correct, ne garde plus de lignes vides dans tableaux structurés.
Nettoyé ton fichier passe bien sur le forum.
Bonne soirée

 

[Bebere]

Bonjour
Et si tu joignais un fichier

 

[Bebzinda]

Ok! Ce fichier est un exemple

 

[Chris401]

Bonjour
Regarde si ça te convient.

 

[Bebzinda]

Bonjour
Regarde si ça te convient.

Merci bien! Ça me va!!!

 

[cp4]

Bonjour @Bebzinda , @Chris401 ,

@Bebzinda : Une autre approche similaire à celle de Chris401, utilisant le nom des feuilles.

Sub Regrouper_Feuilles()
    Application.ScreenUpdating = False
    Dim F As Worksheet, ws As Worksheet
    Set F = Sheets("synthèse")
    F.Range("A1").CurrentRegion.Offset(1).Delete

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> F.Name Then
            ws.Range("A1").CurrentRegion.Offset(1).Copy F.Range("A" & Rows.Count).End(xlUp)(2)
        End If
    Next ws
    Application.ScreenUpdating = True

End Sub

Bonne journée.

 

[Bebzinda]

Merci bien! Ça me va!!!

Bonjour
Regarde si ça te convient.

je voudrais que la copy se limite a ces trois feuil uniquement est ce possible?

 

[Chris401]

Bonjour @cp4

Ce qui évite de placer la feuille "synthèse" en 1er.

 

[Phil69970]

Bonjour à tous

Sur le code de @cp4
Perso je pense qu'il faut mieux remplacer :

F.Range("A1").CurrentRegion.Offset(1).Delete

Par :

F.Range("A1").CurrentRegion.Offset(1).ClearContents

@Phil69970

 

[Bebzinda]

Bonjour @cp4

Ce qui évite de placer la feuille "synthèse" en 1er.

Ah ok merci!

 

[Chris401]

Quand tu dis :"je voudrais que la copy se limite a ces trois feuil uniquement est ce possible?"
Tu as d'autres feuilles que tu ne veux pas prendre en compte ?

 

[cp4]

Bonjour à tous

Sur le code de @cp4
Perso je pense qu'il faut mieux remplacer :

F.Range("A1").CurrentRegion.Offset(1).Delete

Par :

F.Range("A1").CurrentRegion.Offset(1).ClearContents

@Phil69970

Salut Phil,

Pas tout à fait d'accord avec toi. Car Copy , copie même le format. ClearContents ne supprime que le contenu des cellules.

 

[Phil69970]

Re

Alors il suffit de les supprimer aussi

F.Range("A1").CurrentRegion.Offset(1).ClearFormats
F.Range("A1").CurrentRegion.Offset(1).ClearContents

Car si l'utilisateur a des données au delà de "CurrentRegion" (en F2 et/ou G2 par exemple) alors cela va faire bizarre avec delete.

@Phil69970

 

[cp4]

Re

Alors il suffit de les supprimer aussi

F.Range("A1").CurrentRegion.Offset(1).ClearFormats
F.Range("A1").CurrentRegion.Offset(1).ClearContents

Car si l'utilisateur a des données au delà de "CurrentRegion" (en F2 et/ou G2 par exemple) alors cela va faire bizarre avec delete.

@Phil69970

@Phil69970 : En effet, étourderie de ma part Delete est bizarre, le plus indiqué est Clear

@Bebzinda : Si j'ai bien compris ta demande.

Sub Regrouper_Feuilles_Concernées()
    Dim F As Worksheet, a, i As Integer, Sh As Worksheet
    Set F = Worksheets("synthèse")
    Application.ScreenUpdating = False
    a = Array("Feuil1", "Feuil2", "Feuil3")    'on met le nom des feuilles à copier dans une variable tableau (adapter nom feuilles)
    Debug.Print LBound(a), UBound(a)

    F.Range("A1").CurrentRegion.Offset(1).Clear    'on efface

    For i = LBound(a) To UBound(a)
        Set Sh = Worksheets(a(i))
        With Sh
            .Range("A1").CurrentRegion.Offset(1).Copy F.Range("A" & Rows.Count).End(xlUp)(2)
        End With
    Next i
    Set Sh = Nothing: Set F = Nothing
    Application.ScreenUpdating = True
    MsgBox "Transfert terminé!", vbInformation + vbOKOnly, "TRANSFERT DONNEES"
End Sub