S
Sidonie
Guest
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
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