Fusionner un onglet de plusieurs classeurs

Messages postés
2
Date d'inscription
jeudi 3 janvier 2019
Statut
Membre
Dernière intervention
3 janvier 2019
- - Dernière réponse : didibonf
Messages postés
418
Date d'inscription
vendredi 18 juillet 2008
Statut
Membre
Dernière intervention
21 mai 2019
- 3 janv. 2019 à 14:08
Bonjour,

Je débute de zéro sur VBA.

Je suis à la recherche d'une macro pour récupérer un onglet (portant le meme nom) depuis plusieurs fichiers pour fusionner dans un classeur. J'ai pu récupérer cette macro ci-dessous sur le forum mais il fusionne tous les onglets apparement alors que je souhaiterais fusionner que les onglets s"appelant "xxx" et nommant ces onglets dans le nouveau classeur par le nom se trouvant dans la cellule A1 de chaque onglet.
Pouvez vous svp m'aider à ajouter ce critere dans la macro ci-dessous ?
D'avance, merci infiniment !!!
Amandine

______
Sub Import()

'Source
Dim ClasseurSource As Workbook
Set ClasseurSource = ActiveWorkbook

'Chemin du dossier où sont les classeurs excel
Dim CheminTypeDonnees As String
'soit en hard
CheminTypeDonnees = "C:\Users\NHTRAN\Desktop\LOCAL NT\2018.12\EUR\*.*" 'chemin a modifier biensur
'soit en relatif
'chemin = classeursource.Sheets(1).range("A1").value
'dans ce cas il faut mettre le chemin comme marqué ci-dessus dans la case A1
'Attention à bien laisser l'extension dans le chemin ! Si tu as plusieurs type de fichiers il faut mettre *.xls ou *xlsm suivant ce que tu as.

'Définition du chemin à tester - PERMET DE "MONTRER" LE CHEMIN A LA MACRO
Dim RetVal As Boolean
Dim Chemin As String
Chemin = "C:\Users\NHTRAN\Desktop\LOCAL NT\2018.12\EUR"
ChDir Chemin
RetVal = Application.Dialogs(xlDialogOpen).Show(CheminTypeDonnees) 'ouverture de la boite de dialogue
If RetVal = True Then Exit Sub
'Si le chemin montré est correct, pressez sur annuler ! Pour que la macro continue. Je n'ai malheureusement toujorus pas trouvé d'autre façon de faire pour "montrer" à la macro le chemin de base sans tout faire buger la première fois.

'Y a t'il des fichiers dans le répertoire ?
Dim objOFS As Variant
Set objOFS = CreateObject("Scripting.FileSystemObject")

'Test si au moins un fichier present
If Dir(CheminTypeDonnees) <> "" Then

'Activer le classeur source
ClasseurSource.Activate

'Gérer le répertoire de fichiers excel
fichier = Dir(CheminTypeDonnees)
Do While fichier <> ""
Set wbsource = Workbooks.Open(fichier) 'ouverture du premier classeur
Set wksNewSheet = wbsource.Sheets(2) 'selection du premier onglet
wksNewSheet.Copy after:=ClasseurSource.Sheets(1) ' mets a la place du 1 le dernier onglet de ton classeur principal
ClasseurSource.Activate
wbsource.Close 'fermerture du classeur excel dont l'onglet a été copié
fichier = Dir 'Prochain classeur
Loop 'bouclage
End If

End Sub
Afficher la suite 

1 réponse

Messages postés
418
Date d'inscription
vendredi 18 juillet 2008
Statut
Membre
Dernière intervention
21 mai 2019
46
0
Merci
Bonjour,
Je pense qu’il faut modifier la ligne :
Set wksNewSheet = wbsource.Sheets(2) 'selection du premier onglet 

Et mettre le nom de l’ongel à la place du 2 :
Set wksNewSheet = wbsource.Sheets("XXX") 'selection du premier onglet 
amandine_nt
Messages postés
2
Date d'inscription
jeudi 3 janvier 2019
Statut
Membre
Dernière intervention
3 janvier 2019
-
merci pour votre aide
c'est bien ce qu'il fallait faire!!
Sauriez vous comment faire pour renommer les onglets par une valeur dans une cellule car pour l'instant ils s'appelle tous "xxx (1)" "xxx (2)"
didibonf
Messages postés
418
Date d'inscription
vendredi 18 juillet 2008
Statut
Membre
Dernière intervention
21 mai 2019
46 -
Peut-être quelque chose comme cela (pas testé) :
ClasseurSource.Activate 
Sheets("xxx").Name = Sheets("xxx").Range("A1")
wbsource.Close 'fermerture du classeur excel dont l'onglet a été copié 

(deuxième ligne à insérer entre ligne 1 et 3 déjà présente dans le code)
Commenter la réponse de didibonf