Export Excel sans écraser l'existant

Résolu
ptitbow Messages postés 6 Statut Membre -  
baladur13 Messages postés 47319 Date d'inscription   Statut Modérateur Dernière intervention   -
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

1 réponse

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    ecriture a partir de la ligne 2 

    Sub test()
    Dim classeurSource As Workbook, classeurDestination As Workbook
    
    Application.ScreenUpdating = False
    '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
    With classeurDestination.Sheets("Sheet1")
        'premiere cellule vide colonne A
        PLV = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A" & PLV & ":Z" & PLV).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=True, Transpose:=True
    End With
    'fermer le classeur source
    classeurSource.Close False
    Application.ScreenUpdating = True
End Sub
    0