XL 2016 Copy

Bebzinda

XLDnaute Nouveau
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

XLDnaute Barbatruc
Bonjour @Bebzinda :), @Chris401 ;),

@Bebzinda : Une autre approche similaire à celle de Chris401, utilisant le nom des feuilles.
VB:
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.
 

Phil69970

XLDnaute Barbatruc
Re

Alors il suffit de les supprimer aussi

VB:
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

XLDnaute Barbatruc
Re

Alors il suffit de les supprimer aussi

VB:
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.
VB:
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
 

Discussions similaires

Réponses
4
Affichages
536