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

XLDnaute Nouveau
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 ;
VB:
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

XLDnaute Barbatruc
Bonjour aka100k, bienvenue sur XLD,

Il faut coller les données à partir de la 1ère ligne vide :
VB:
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+
 

job75

XLDnaute Barbatruc
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 :rolleyes:

S'il y a des en-têtes en ligne 1 qu'il faut éviter utilisez :
VB:
    With Workbooks.Open(ListeFichier)
        .Sheets(1).[A1].CurrentRegion.Offset(1).Copy dest 'copier-coller
        .Close False
    End With
 

aka100k

XLDnaute Nouveau
C(est vous qui au post #1 copiez [A2].CurrentRegion :rolleyes:

S'il y a des en-têtes en ligne 1 qu'il faut éviter utilisez :
VB:
    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é
 

Discussions similaires