Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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+
 

aka100k

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

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

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

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…