XL 2019 Besoin d'aide pour copier les lignes d'un classeur et les coller dans un autre classeur par le bié d'un bouton (VBA)

[aka100k]

Bonjour a tous,
pour le travail j'ai besoin de transferer des données d'un classeur a un autre par le bié d'un bouton.
mon code est le suivant ;

Sub RécupérationOTfichier()
    Dim ListeFichier As Variant
    Dim MonClasseur As Workbook
    
    'Application.CutCopyMode = False
    'Aplication.ScreenUptdating = False
    
    ActiveSheet.Range("A7").CurrentRegion
    ListeFichier = Application.GetOpenFilename(Title:="séléctionnez votre classeur", filefilter:="Fichiers Excel(*.xls*), *xls*", ButtonText:="Cliquez")

    
    If ListeFichier <> False Then
    Set MonClasseur = Application.Workbooks.Open(ListeFichier)
    MonClasseur.Sheets(1).Range("A2").CurrentRegion.Copy
    ThisWorkbook.ActiveSheet.Range("A7").PasteSpecial xlPasteAll
    Application.DisplayAlerts = False
    MonClasseur.Close
    End If
      
    
    'Application.CutCopyMode = True
    'Application.ScreenUpdating = True
    

End Sub

sauf que lorsque je souhaite coller d'autres lignes il les colles par dessus les anciennes, ce que je ne veux absolument pas !
Je pense que c'est due a cette ligne ( ThisWorkbook.ActiveSheet.Range("A7").PasteSpecial xlPasteAll ) mais je n'arrive pas a résoudre le prolème par moi même j'aurais besoin que vous me mettiez sur la piste s'il vous plait !
Merci d'avance

 

[job75]

Bonjour aka100k, bienvenue sur XLD,

Il faut coller les données à partir de la 1ère ligne vide :

Sub RécupérationOTfichier()
    Dim ListeFichier As Variant, dest As Range
    ListeFichier = Application.GetOpenFilename(Title:="séléctionnez votre classeur", filefilter:="Fichiers Excel(*.xls*), *xls*", ButtonText:="Cliquez")
    If ListeFichier = False Then Exit Sub
    Set dest = Cells.Find("*", , xlValues, , xlByRows, xlPrevious) 'dernière cellule non vide
    If dest Is Nothing Then Set dest = [A7] Else Set dest = Cells(dest.Row + 1, 1)
    If dest.Row < 7 Then Set dest = [A7]
    Application.ScreenUpdating = False
    With Workbooks.Open(ListeFichier)
        .Sheets(1).[A2].CurrentRegion.Copy dest 'copier-coller
        .Close False
    End With
End Sub

A+

 

[aka100k]

Merci de ton aide, tput fonctionne comme je l'éspérais

 

[aka100k]

j'ai juste une autre question, pourquoi lors du copier coller les lignes séléctionnez comprenne aussi la ligne 1 ? car dans le code que tu as fait le paramètre de séléction est pour A2 -> current region.

 

[job75]

j'ai juste une autre question, pourquoi lors du copier coller les lignes séléctionnez comprenne aussi la ligne 1 ? car dans le code que tu as fait le paramètre de séléction est pour A2 -> current region.

C(est vous qui au post #1 copiez [A2].CurrentRegion

S'il y a des en-têtes en ligne 1 qu'il faut éviter utilisez :

    With Workbooks.Open(ListeFichier)
        .Sheets(1).[A1].CurrentRegion.Offset(1).Copy dest 'copier-coller
        .Close False
    End With

 

[aka100k]

C(est vous qui au post #1 copiez [A2].CurrentRegion

S'il y a des en-têtes en ligne 1 qu'il faut éviter utilisez :

    With Workbooks.Open(ListeFichier)
        .Sheets(1).[A1].CurrentRegion.Offset(1).Copy dest 'copier-coller
        .Close False
    End With

justement oui c'etait bien ce que je voulais faire copier et coller a partir de A2 sauf que ca copie aussi A1 et je ne comprend pas pourquoi, désolé si je me suis mal exprimé

 

[job75]

copier et coller a partir de A2 sauf que ca copie aussi A1 et je ne comprend pas pourquoi

[A2].CurrentRegion prend en compte toutes les valeurs qui entourent A2, donc la ligne 1.

Avec Offset(1) on saute la ligne 1.

 

[aka100k]

super tout marche au top, merci pour tout