Correction macro fusion feuilles

Sidonie · 17 Mars 2005

Bonjour Le Forum

Ai repris dans les archives une macro qui reprend les données de différentes feuilles selon un critère donné pour les fusionner dans un fichier à la suite l'une de l'autre dans une même feuille. (je ne me souviens plus de l'auteur, mais sa macro m'a bien rendu service, merci à lui).

J'ai donc adapté la macro à mes besoins. Il reste pourtant une modification à faire et je ne trouve pas la solution qui doit être très facile (quand on connait son domaine).

Voici l'énoncé :

Lorsque je reprends les données de mes deux feuilles identifiées par le critère oui dans une colonne M, la dernière ligne de mon tableau n'est pas reportée dans le fichier. La dernière ligne est vide en dehors du oui. Si je mets un contenu dans les 2 premières cellules, elle est reportée. Mais il ne devrait pas y avoir de contenu.

J'ai ajouté +1 dans la macro (en rouge). Avec ça, la dernière ligne du deuxième fichier est reportée, même sans contenu. Par contre, la dernière ligne du premier fichier n'est pas prise. Et j'aimerais vraiment pouvoir l'insérer pour faciliter la lecture du tableau.

Je vous livre ci-dessous la macro que j'utilise. D'avance un grand merci pour votre aide.

Sidonie

'
Range('A7').Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.EntireRow.Delete
Range('A1').Select
'
chemin = ThisWorkbook.Path & '\\Données\\'
nomfichier = ActiveWorkbook.Name
critère = 'oui'
'
Set fs = Application.FileSearch
With fs
.LookIn = chemin
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox 'Ce dossier contient ' & .FoundFiles.Count & _
' fichier(s) répondant aux critères.'
For i = 1 To .FoundFiles.Count
fichierlu = .FoundFiles(i)
MsgBox .FoundFiles(i)
Workbooks.Open Filename:=fichierlu
fenêtrelue = ActiveWorkbook.Name
Range('a1').Select
Selection.AutoFilter
Selection.AutoFilter Field:=13, Criteria1:=critère
' taille de la sélection à copier
Range('a65536').Select
Selection.End(xlUp).Select
If ActiveCell.Value <> 1 Then
dernière_ligne = ActiveCell.Row + 1
Range('A7:L' & dernière_ligne).Select
Selection.Copy
Windows(nomfichier).Activate
'mettre à la suite
Range('a65536').Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End If
Windows(fenêtrelue).Activate
' Selection.AutoFilter Field:=2
Application.CutCopyMode = False
Selection.AutoFilter
ActiveWindow.Close SaveChanges:=False
Windows(nomfichier).Activate
Range('A1').Select

Next i
Else
MsgBox 'Aucun fichier n'a été trouvé.'
End If
End With
End Sub

Sidonie · 17 Mars 2005

Correction macro fusion feuilles (bis)

Bonsoir à tous,

Je réactualise le sujet, pas de solution concluante hors bricolage pour l'instant. Peut-être qu'à cette heure-ci, d'autres visiteurs et spécialistes es Excel sauront me répondre.

Merci
Sidonie

Hellboy · 17 Mars 2005

Re:Correction macro fusion feuilles (bis)

Bonjour

Je pense que les modifs apportées vont vous permettre d'accomplir ce que vous désirez.

Range('A7').Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.EntireRow.Delete
Range('A1').Select
'
chemin = ThisWorkbook.Path & 'Données'
nomfichier = ActiveWorkbook.Name
critère = 'oui'
'
Set fs = Application.FileSearch
With fs
.LookIn = chemin
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox 'Ce dossier contient ' & .FoundFiles.Count & _
' fichier(s) répondant aux critères.'
For i = 1 To .FoundFiles.Count
fichierlu = .FoundFiles(i)
MsgBox .FoundFiles(i)
Workbooks.Open Filename:=fichierlu
fenêtrelue = ActiveWorkbook.Name
Columns('M:M').AutoFilter
Selection.AutoFilter Field:=1, Criteria1:='oui' 'critère
' taille de la sélection à copier
With Range('M2:M65536').SpecialCells(xlCellTypeVisible).Areas
Range('A' & .Item(1).Row & ':L' & .Item(.Count).Row).SpecialCells(xlCellTypeVisible).Copy
End With
Windows(nomfichier).Activate
'mettre à la suite
Range('A65536').End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=False
Windows(fenêtrelue).Activate
' Selection.AutoFilter Field:=2
Application.CutCopyMode = False
Selection.AutoFilter
ActiveWindow.Close SaveChanges:=False
Windows(nomfichier).Activate
Range('A1').Select

Next i
Else
MsgBox 'Aucun fichier n'a été trouvé.'
End If
End With
End Sub

Phil

Message édité par: Hellboy, à: 17/03/2005 17:47

Message édité par: Hellboy, à: 17/03/2005 17:50

Sidonie · 21 Mars 2005

Re:Correction macro fusion feuilles (bis)

Hellboy écrit:

Selection.AutoFilter Field:=1, Criteria1:='oui' 'critère

Message édité par: Hellboy, à: 17/03/2005 17:47<br><br>Message édité par: Hellboy, à: 17/03/2005 17:50

Hello Hellboy

Tout d'abord merci pour ton aide. Je reviens d'un long week-end et ravie de trouver une réponse à mon post.

Ai essayé tout de suite ta macro. Malheureusement, elle bloque sur le filtre et me renvoie via la débogueur à la phrase que j'ai laissée en référence.

Il manquait aussi le signe \\ dans données au tout début, mais ça j'ai réussi à le trouver seule.

Par contre, je viens d'essayer de solutionner l'autre partie, pour l'instant sans succès.

Alors si tu as une idée pour passer par-dessus, elle est la bienvenue.

Merci
Sidonie

Hellboy · 21 Mars 2005

Re:Correction macro fusion feuilles (bis)

Selection.AutoFilter Field:=1, Criteria1:='oui' 'critère

Change pour:
Selection.AutoFilter Field:=1, Criteria1:=critère

Tu m'en donne des nouvelles S.V.P

Philippe

Sidonie · 21 Mars 2005

Re:Correction macro fusion feuilles (bis)

Merci Hell Boy

Ai modifié selon ta proposition et le message est identique. Je ne vois pas pourquoi il ne veut pas reconnaître cette commande.

Entre-temps j'ai bricolé le fichier d'origine dans lequel les données sont reprises (le fichier 1). J'ai ajouté une ligne avec des données texte qui indiquent à l'utilisateur le changement de source. Comme ça il me prend la ligne car il la considère comme active, me prend celle d'avant que je voulais car elle est dans la sélection et l'utilisateur ne va pas la supprimer car elle lui sera utile. C'est peu orthodoxe je sais, mais je fais avec mes maigres connaissances de ce langage que je découvre depuis quelques jours.

En attendant, si tu veux continuer à chercher une solution 'correcte', c'est bien volontiers que je la testerai.

Merci encore
Sidonie

Hellboy · 21 Mars 2005

Re:Correction macro fusion feuilles (bis)

Bonjour

Ca commence drôlement :lol: . Bon, Un pourrais-tu m'envoyer ton fichier que tu utilise ta macro s.v.p. J'aimerais voir de plus ce qui se passe. Si non, porrais-tu me dire si le filtre automatique ds les feuille de excel est déjà activé avant que tu démarre la macro ?

A+

Phil

Sidonie · 22 Mars 2005

Re:Correction macro fusion feuilles (bis)

Bonjour Hellboy, bonjour le forum

Hellboy,

Ai vérifié l'histoire des filtres automatiques et effectivement, il y en avait un d'activé. Je l'ai enlevé. Ensuite la macro a buté sur des cellules fusionnées, j'ai changé cela aussi. Ensuite la macro fonctionne, mais le résultat n'est pas tout à fait celui que j'espérais.

Pour te permettre de te faire une idée, je mets ici deux fichiers (deux messages). Le premier, décompte1, est celui qui est généré par ta macro. Le second, décompte, est celui qui est généré par ma macro bricolée. Dans le second, je me rends compte qu'il garde le filtre automatique dans le fichier source, ce qui n'est pas super car on ne voit plus les titres des colonnes et mes utilisateurs vont être perdus. Peut-être peut-on modifier le script en ce sens ?

Pour mémoire, les deux fichiers Genève et Zurich sont à placer dans un répertoire nommé respectivement données et données1 directement adjacent à celui dans lequel sera enregistré le fichier récapitulatif decompte et decompte1.

J'espère que c'est à peu près clair, sinon n'hésite pas.

Et encore un grand merci.
Sidonie [file name=Decompte1.zip size=45485]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Decompte1.zip[/file]

Sidonie · 22 Mars 2005

Re:Correction macro fusion feuilles (bis)

Voici le second fichier... [file name=Decompte_20050322112242.zip size=47675]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Decompte_20050322112242.zip[/file]

Hellboy · 22 Mars 2005

Re:Correction macro fusion feuilles (bis)

Bonjour

Désolé pour le délais. Enfin, j'ai testé la macro que vous m'avez envoyé et effectué quelques changements. Avant de vous montrer le code, la seul chose que je vois qui va faire planté le résultats escompté, c'est si il y a le filtre automatique déjà activé dans les fichier que vous ouvrez. Et voici le code:

Sub Fusion()
'
' Fusion Macro
' Macro enregistrée le 17.03.2005 par Sabine Kastler
'
Range('A3').Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.EntireRow.Delete
Range('A1').Select
'
chemin = ThisWorkbook.Path & '\\Données1\\'
nomfichier = ActiveWorkbook.Name
critère = 'oui'
'
Set fs = Application.FileSearch
With fs
.LookIn = chemin
If .Execute(SortBy:=msoSortByFileName, SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox 'Ce dossier contient ' & .FoundFiles.Count & _
' fichier(s) répondant aux critères.'

For i = 1 To .FoundFiles.Count
fichierlu = .FoundFiles(i)
MsgBox .FoundFiles(i)
Workbooks.Open Filename:=fichierlu
fenêtrelue = ActiveWorkbook.Name
Range(Cells(6, 13), Cells(Cells(65000, 13).End(xlUp).Row, 13)).AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=critère 'critère

With Range('M6:M65536').SpecialCells(xlCellTypeVisible)
Range('A' & .Find('oui').Row & ':L' & .Find('oui', SearchDirection:=xlPrevious).Row).SpecialCells(xlCellTypeVisible).Copy
End With
Windows(nomfichier).Activate

'mettre à la suite
Range('A65536').End(xlUp).Offset(1, 0).Select

Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=False

'Si désirez, les 2 lignes ci-dessous, copy le format seulement de la feuille1 du fichiers 'Décompte.xls'

'Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:= _
'True, Transpose:=False

Windows(fenêtrelue).Activate

' Selection.AutoFilter Field:=2
'Application.CutCopyMode = False
'Selection.AutoFilter

' Si vous ne sauve gardez pas les changements les lignes ci-dessus son inutiles
ActiveWindow.Close SaveChanges:=False

Windows(nomfichier).Activate
Range('A1').Select

Next i
Else
MsgBox 'Aucun fichier n'a été trouvé.'
End If
End With
End Sub

Philippe

Message édité par: Hellboy, à: 22/03/2005 18:53

Correction macro fusion feuilles

Sidonie

Guest

Sidonie

Guest

Hellboy

XLDnaute Accro

Sidonie

Guest

Hellboy

XLDnaute Accro

Sidonie

Guest

Hellboy

XLDnaute Accro

Sidonie

Guest

Pièces jointes

Sidonie

Guest

Pièces jointes

Hellboy

XLDnaute Accro

Discussions similaires