Fusion de classeurs Excel avec VBA avec conditions
Bonjour à tous !
J'ai encore besoin de votre précieuse aide.
Je dois fusionner près de 600 fichiers Excel.
Chacun est composé de 12 colonnes et entre 20'000 et 100'000 lignes.
J'ai trouvé solution à mon problème avec ce code dans le post suivant :
https://forum.excel-pratique.com/post290068.html?hilit=fusion%20plusieurs%20classeur#p290068
dans la réponse de https://forum.excel-pratique.com/membre22904.html @h2so4 /PROPS
J'ai juste modifier les .xls en .xlsx pour que cela fonctionne chez moi
Ma question est la suivante :
Quand je lance la macro je dois valider manuellement les 600 pop-up du presse-papier m'indiquant pour chaque fichier :
Le presse-papiers contient une grande quantité d'informations. Voulez-vous avoir la possibilité de coller ces informations dans le un autre document ultérieurement ?
Pour enregistrer dans le presse-papiers afin de pouvoir les coller ultérieurement, cliquez Oui.
Pour les supprimer du Presse-papiers et libérer de la mémoire, cliquez sur Non
Je veux bien entendu cliquer sur Non.
Étant donnée que je dois faire cette opération plusieurs fois par semaine, je me demandais si vous arriveriez à me facilité la vie encore une fois
Sub fusionclasseur()
Set wbf = ThisWorkbook ' wbf reférence le classeur maitre
Set wsc = wbf.Worksheets.Add ' on ajoute une feuille dans le classeur maitre
wsc.Name = "Résultat fusion" ' on nomme la feuille " résultat fusion"
'-------------------------------
' on demande le nom du répertoire qui contient les fichiers à fusionner via dialogue windows
' résultat dans chemin
Set fd = Application.FileDialog(msoFileDialogFolderPicker)
With fd
.Title = "Sélectionner le répertoire contenant les fichiers à fusionner"
.Filters.Clear
.AllowMultiSelect = False
If .Show = -1 Then ' si un répertoire sélectionné
chemin = .SelectedItems(1) & "\" ' on le met dans chemin
Else
Exit Sub 'pas de répertoire sélectionné, on arrête
End If
End With
'---------------------------------
masque = InputBox("introduire le filtre de sélection des classeurs (défaut *.xlsx*)") ' masque est le filtre des fichiers à sélectionner
wsn = InputBox("Nom de la feuille à copier de chaque classeur (défaut première feuille trouvée)") ' wsn nom de la feuille à copier de chaque classeur à fusionner
If masque = "" Then masque = "*.xlsx*" ' si masque est vide on attribue le filtre par défaut
f = Dir(chemin & masque) ' f= nom du premier fichier correspondant au critère
ctrf = 0 ' compteur de classeurs fusionnés
pli = 1 'première ligne sur résultat fusion
While f <> "" ' tant qu'il y a des fichiers(classeurs)) à fusionner
If wbf.Name <> f Then ' si classeur différent du classeur maitre
ctrf = ctrf + 1
Set wbi = Workbooks.Open(chemin & f) ' on ouvre le classeur
If wsn = "" Then Set wsi = wbi.Worksheets(1) Else Set wsi = wbi.Worksheets(wsn) ' on sélectionne la feuille à fusionner =wsi
dli = wsi.Range("A" & Rows.Count).End(xlUp).Row ' dli dernière ligne sur wsi
If dli > 1 Then
If ctrf = 1 Then pl = 1 Else pl = 2 ' si premier classeur à fusionner, il faut copier l'entête
wsi.Rows(pl & ":" & dli).Copy
wsc.Range("a" & pli).PasteSpecial Paste:=xlPasteValues 'on copie les lignes du classeur à fusionner dans la feuille résultat de fusion
pli = pli + dli + 1 - pl ' on ajuste le nombre de lignes de résultat fusion
End If
wbi.Close 'on ferme le classeur
End If
f = Dir() 'on passe au classeur suivant
Wend
End SubJe sais pas si c'est possible d'influer sur ces pop-up depuis VBA... comme vous l'avez compris je suis pas Pro sur VBA.
Merci d'avance à vous.
Codialement,
James
Bonjour,
Au tout début de ton code, tu peux insérer ...
Application.DisplayAlerts = FalseMerci pour votre réponse M.Bond !
Trop facile pour vous !
Cordialement,
Un autre James lol
Newbie2000 a écrit :Merci pour votre réponse M.Bond !
Trop facile pour vous !
Cordialement,
Un autre James lol
Ravi que la solution fonctionne ...