Export Excel sans écraser l'existant

Bonjour,

Je débute un peu en VBA et j'aimerais faire appel à votre aide concernant une petite manipulation sous Excel.

J'exporte des données d'un fichier Excel à un autre. Cela fonctionne correctement.

Néanmoins, je vais être amené à faire la manip' régulièrement et lorsque je relance le procédure une seconde fois, les données s'exportent mais remplacent les données existantes.

J'aimerais ajouter tester et copier les nouvelles données dans une nouvelle ligne (L+1) si la ligne précédente n'est pas vide.

Voici mon code d'export :

Sub test()
Dim classeurSource As Workbook, classeurDestination As Workbook

'définir le classeur destination
Set classeurDestination = ThisWorkbook

If Not Application.Dialogs(xlDialogOpen).Show Then Exit Sub

Set classeurSource = ActiveWorkbook

'copier les données de la "Feuil1" du classeur source vers la "Feuil1" du classeur destination
classeurSource.Sheets("Sheet1").Range("D5:D20").Cells.Copy

classeurDestination.Sheets("Sheet1").Range("A1:Z1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=True

'fermer le classeur source
classeurSource.Close False

End Sub

Je vous remercie d'avance

J'ai résolu le problème grâce à un expert

Dim AddL As Long
AddL = classeurDestination.Sheets("Sheet1").Range("A" & classeurDestination.Sheets("Sheet1").Cells.Rows.Count).End(xlUp).Row + 1
classeurDestination.Sheets("Sheet1").Range("A" & DerL & ":Z" & DerL).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=True

Ci cela peut aider certaines personnes

Cheers

Bonjour,

A tester

Option Explicit
Public Sub test()
Dim wbSource As Workbook, wbTarget As Workbook
Dim lRow As Long
    'définir le classeur destination
    Set wbTarget = ThisWorkbook
    lRow = wbTarget.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row + 1

    If Not Application.Dialogs(xlDialogOpen).Show Then Exit Sub

    Set wbSource = ActiveWorkbook
    'copier les données de la "Feuil1" du classeur source vers la "Feuil1"
    'du classeur destination
    Sheets("Sheet1").Range("D5:D20").Cells.Copy
    wbTarget.Sheets("Sheet1").Range("A" & lRow & ":Z1" & lRow).PasteSpecial _
            Paste:=xlPasteAll, _
            Operation:=xlNone, _
            SkipBlanks:=True, _
            Transpose:=True
    'fermer le classeur source
    wbSource.Close False

    Set wbTarget = Nothing
    Set wbSource = Nothing

End Sub

Je te remercie Jean-Eric

Re,

Merci et à bientôt.

Rechercher des sujets similaires à "export ecraser existant"