Fusion de Fichier VBA

[Deluxe35]

Bonjour,

Tout d'abord, je débute sur VBA.

Je souhaite copier les cellules de plusieurs fichiers Excel appartenant à un même dossier dans un nouveau fichier Excel. Je suis aujourd'hui rendu à ce code mais je rencontre une dernière problématique :
le fichier 1 s'ouvre, se colle dans le fichier final, puis le deuxième fichier s'ouvre et au lieu de se mettre à la suite, il écrase le fichier 1, etc...

Pourriez-vous m'aider?

Aujourd'hui voici mon code:

Sub recup()
Dim CD As Workbook 'déclare la variable CD (Classeur Destination)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set CD = ThisWorkbook 'définit le classeur destination CD
Set OD = CD.ActiveSheet 'définit l'onglet destination OD
Chemin = "C:\Users\Adrien\OneDrive Entreprise 1\Travail\Demande Agence\" 'saisir le chemin complet du dossier où se trouvent les fichiers
Fichier = Dir(Chemin & "*.xls") ' Premier fichier
Do While Fichier <> ""
Workbooks.Open Filename:=Chemin & Fichier
Set CS = ActiveWorkbook 'définit le classeur source CS
Set OS = CS.Worksheets(1) 'définit l'onglet source OS (à adaper)
'définit la cellule de destination DEST (A1 si A1 est vide, sinon la première cellule vide de la colonne A de l'onglet destination OD)
Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))
OS.Range("A1").CurrentRegion.Copy DEST 'copy la plage nommée "TOUT" de l'onglet source dans DEST
CS.Close savechanges:=False 'ferme le classeur source sans enregistrer
Fichier = Dir ' Fichier suivant
Loop
End Sub


Merci beaucoup de votre aide,

Adrien

 

[job75]

Bonjour Adrien, Joël, Roland,

En remplaçant :

Set DEST = IIf(OD.Range("A1").Value = "", OD.Range("A1"), OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0))

par :

If Application.CountA(OD.Cells) Then
  Set DEST = OD.Cells(OD.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row + 1, "A")
Else
  Set DEST = OD.[A1]
End If

il n'y aura jamais de problème, quelles que soient les configurations.

Bonne journée

 

[Deluxe35]

Yeees ! Merci beaucoup à vous. C'est exactement ce que je souhaitais.
En espérant pouvoir vous aider sur un autre type de problématique !!!

Merci encore

Adrien