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 · 19 Avril 2022

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 · 19 Avril 2022

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 · 20 Avril 2022

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

aka100k · 20 Avril 2022

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 · 20 Avril 2022

aka100k à dit:
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 · 20 Avril 2022

job75 à dit:
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

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 · 20 Avril 2022

aka100k à dit:
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 · 20 Avril 2022

super tout marche au top, merci pour tout

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

job75

XLDnaute Barbatruc

aka100k

XLDnaute Nouveau

aka100k

XLDnaute Nouveau

job75

XLDnaute Barbatruc

aka100k

XLDnaute Nouveau

job75

XLDnaute Barbatruc

aka100k

XLDnaute Nouveau

Discussions similaires