Regrouper des feuilles d'un classeur par critère
Bonsoir
existe il une facon de pouvoir regrouper certaines feuilles d'un meme classeur nommé C1 ( vers un autre classeur ) selon un critère simple qui serait par exemple : "si toutes les cellules H7 de toutes mes feuilles de mon classeur C1 sont renseignées alors toutes ces feuilles seraient automatiquement renvoyées en copie dans un nouveau classeur que je pourrai appeler "extraction de feuilles " ?
cela est il possible ?
Merci pour vos avis
Salut Rocket,
Oui c'est possible.
Voici une tentative de démonstration. Tu places les deux fichiers joins dans le même dossier puis tu ouvres le fichier "C1".
Lorsque tu cliques sur le bouton, ça devrait ouvrir le fichier "Extraction de feuilles" et y enregistrer une copie des feuilles comportant une cellule H7 non vide du fichier "C1". Ca fonctionne en tout cas bien che moi
Lorsque cela est fait, que désires-tu ? Refermer le fichier "Extraction de feuilles" après l'avoir enregistré ? Sélectionner une autre feuille que la dernière feuille du fichier "C1" (par exemple revenir sur la première feuille) ?
A te relire.
.. je ne peux rester que sans voix devant tes prouesses Yvouille ! ....excel se déshabille pour certains
il me vient une nouvelle question relative à ce post ,
Est qu'il est possible d'inclure dans la macro du bouton d'extraction des feuilles voulues , une ligne de commande permettant de créer le classeur "extraction de feuilles" avant que la copie des feuilles soit effectuée sur ce dernier et que lorsque la copie est effectuée de nettoyer toutes les cellules H7 de toutes les pages du classeur C1
voila ce que j'ai essayé de faire à partir de ton code , si tu peux m'apporter une correction :
Option Explicit
Sub a()
Dim Chemin As String, j As Integer
Application.ScreenUpdating = False
Chemin = ActiveWorkbook.Path
WorkBooks.Add
ActiveWorkbook.SaveAs "C:\Chemin &\Extractions de feuilles.xls" ' je crée le classeur extraction
Windows("C1.xls").Activate
For j = 1 To Sheets.Count
Sheets(j).Activate
If Range("H7") <> "" Then
Sheets(j).Copy Before:=Workbooks("Extraction de feuille.xls").Sheets(1)
Windows("C1.xls").Activate
End If
For j = 1 To Sheets.Count
Sheets(j).Activate
Range("H7").Clear ' je nettoie toutes les cellules h7 du classeur C1
Next
End Sub
merci beaucoup
je l'ai refait en plus propre car ca ne marchait pas
ca donne :
Option Explicit
Sub a()
Dim Chemin As String, j As Integer
Application.ScreenUpdating = False
Chemin = ActiveWorkbook.Path
Workbooks.Add
ActiveWorkbook.SaveAs "C:\Users\ROCKET\Desktop\Nouveau dossier (8)\Extraction de feuille.xls"
Workbooks.Open Filename:=Chemin & "\Extraction de feuille.xls"
Windows("C1.xls").Activate
For j = 1 To Sheets.Count
Sheets(j).Activate
If Range("H7") <> "" Then
Sheets(j).Copy Before:=Workbooks("Extraction de feuille.xls").Sheets(1)
Windows("C1.xls").Activate
End If
Next
For j = 1 To Sheets.Count
Sheets(j).Activate
Range("H7").Clear
Next
End Sub
le seul petit soucis que j'ai c'est que j'obtiens sur le classeur "extraction de feuille " des feuilles nommées Feuil1(2) , Feuil2(2)
pourtant je n'ai pas deux fois les memes feuilles , sans comprendre le pourquoi
en plus fournis :
Option Explicit
Sub a()
Dim Chemin As String, j As Integer
Application.ScreenUpdating = False
Chemin = ActiveWorkbook.Path
Workbooks.Add
ActiveWorkbook.SaveAs "C:\Users\AHMED\Desktop\Nouveau dossier (8)\Extraction de feuille.xls"
Workbooks.Open Filename:=Chemin & "\Extraction de feuille.xls"
Windows("C1.xls").Activate
For j = 1 To Sheets.Count
Sheets(j).Activate
If Range("H7") <> "" Then
Sheets(j).Copy Before:=Workbooks("Extraction de feuille.xls").Sheets(1)
Windows("C1.xls").Activate
End If
Next
For j = 1 To Sheets.Count
Sheets(j).Activate
Range("H7").Clear
Next
Windows("Extraction de feuille.xls").Close
With Windows("C1.xls")
Sheets("Feuil1").Select
End With
End Sub
je commence à sentir le vba en moi
Re,
Donc on peut oublier ton premier rajout d'aujourd'hui, non ??rocket4 a écrit :le seul petit soucis que j'ai c'est ......
Concernant le nom des feuilles, cela vient du fait que la copie de la feuille est faite dans le fichier de base, avant son transfert. Si ça te dérange, le plus simple serait de renommer les feuilles à ta convenance, après les avoir dupliquées ou à la fin du code. A toi de nous indiquer comment les renommer si tu ne sais pas le faire.
A te relire.
Voici encore une simplification possible - mais surement pas absolue - du dernier code que tu as fourni :
Sub a()
''''Dim Chemin As String, INUTILISE SUITE A TA MODIFICATION
Dim j As Integer
Application.ScreenUpdating = False
'''''Chemin = ActiveWorkbook.Path INUTILISE SUITE A TA MODIFICATION
Workbooks.Add
ActiveWorkbook.SaveAs "C:\Users\AHMED\Desktop\Nouveau dossier (8)\Extraction de feuille.xls"
'''''Workbooks.Open Filename:=Chemin & "\Extraction de feuille.xls" INUTILE SUITE A TA MODIFICATION CAR DEJA OUVERT
Windows("C1.xls").Activate
For j = 1 To Sheets.Count
Sheets(j).Activate
If Range("H7") <> "" Then
Sheets(j).Copy Before:=Workbooks("Extraction de feuille.xls").Sheets(1)
Windows("C1.xls").Activate
Range("H7").Clear '''' INSTRUCTION DEPLACEE
End If
Next
'''''For j = 1 To Sheets.Count
''''' Sheets(j).Activate
''''' Range("H7").Clear DEPLACE CI-DESSUS
'''''Next
Windows("Extraction de feuille.xls").Close
'''''With Windows("C1.xls") CE FICHIER EST SELECTIONNE
Sheets("Feuil1").Select
'''''End With
End Sub
Attention, dans tes codes tu nous fournis des informations personnelles
Cordialement
merci , pas grave ! ....j'entend pas etre hacké
je ne vois pas comment faire pour renommer les onglets du classeur extraction en fonction du contenu de la cellule H7 de C1
par contre
j'ai pensé à ca :
Windows("C1.xls").Activate
For j = 1 To Sheets.Count
Sheets(j).Activate
Range("H7").copy to
windows("Extraction de feuille").Select
référence_Nom = Range("H7")
sans grosse certitude !
Essaie plutôt
Sub a()
Dim j As Integer
Application.ScreenUpdating = False
Workbooks.Add
ActiveWorkbook.SaveAs "C:\Users\AHMED\Desktop\Nouveau dossier (8)\Extraction de feuille.xls"
Windows("C1.xls").Activate
For j = 1 To Sheets.Count
Sheets(j).Activate
If Range("H7") <> "" Then
Sheets(j).Copy Before:=Workbooks("Extraction de feuille.xls").Sheets(1)
Sheets(j).Name = Range("H7")
Windows("C1.xls").Activate
Range("H7").Clear
End If
Next
Windows("Extraction de feuille.xls").Close
Sheets("Feuil1").Select
End Sub
Cordialement
Merci à toi yvouille , ca marche tres bien mis par que j'ai toujours le probleme des feuilles nommées : feuil2(2)
feuil3(2) ! j'ai pas réussi à résoudre ce probleme ou à m'en defaire apres lecture de ta réponse concernant ce fait . certaines sont bien nommées et portent le nom des cellules h7 des pages à transferer .
Désolé, j'ai fait des essais trop sommaires et je ne me suis pas rendu compte d'un problème (commentaires directement dans le code).
Sub a()
Dim j As Integer
Application.ScreenUpdating = False
Workbooks.Add
ActiveWorkbook.SaveAs "C:\Users\AHMED\Desktop\Nouveau dossier (8)\Extraction de feuille.xls"
Windows("C1.xls").Activate
For j = 1 To Sheets.Count
Sheets(j).Activate
If Range("H7") <> "" Then
Sheets(j).Copy Before:=Workbooks("Extraction de feuille.xls").Sheets(1)
ActiveSheet.Name = Range("H7") 'Modifié afin que ça ne renomme pas une autre feuille que celle désirée
Windows("C1.xls").Activate
Range("H7").ClearContents 'Modifié afin de ne pas effacer la mise en forme
End If
Next
Windows("Extraction de feuille.xls").Close
Sheets("Feuil1").Select
End Sub
Cordialement
Bonjour
Désolé Yvouille d'intervenir dans un post dans lequel tu as trouvé une bonne solution
Dans mon idée je ne voulais que les feuilles (sans celles obtenues à la création du fichier)
Et surtout ne créer un fichier que si nécessaire
Sub a()
Dim Ws As Worksheet
Dim WbkD As Workbook
Application.ScreenUpdating = False
With ThisWorkbook
For Each Ws In .Sheets
If Ws.Range("H7") <> "" Then
If WbkD Is Nothing Then
Ws.Copy
Set WbkD = ActiveWorkbook
Else
Ws.Copy after:=WbkD.Sheets(WbkD.Sheets.Count)
End If
ActiveSheet.DrawingObjects.Delete
ActiveSheet.Name = Ws.Range("H7")
Ws.Range("H7").ClearContents
End If
Next Ws
End With
If Not WbkD Is Nothing Then
With WbkD
.SaveAs "C:\Users\AHMED\Desktop\Nouveau dossier (8)\Extraction de feuille.xls"
' Ma sauvegarde : Evite d'avoir le même nom
' .SaveAs ThisWorkbook.Path & "\Extraction de feuille le " & Format(Now, "yyyy mm dd hhmmss") & ".xls"
.Close
End With
Else
MsgBox "Pas de feuilles à copier"
End If
End Sub
Merci Yvouille je t'en suis infiniment reconnaissant et merci aussi à Banzai pour ce supplément de réponse , j’espère de mon coté progresser le plus tot possible en vba