Séparer des onglets en feuille excel

FCAFE · 2 Novembre 2012

Bonjour

Est il possible de séparer des onglets excel en feuille séparer par un petit programme s'il vous plait
par exemple mettre les onglets sur le bureau en attendant de les traiter, sachant que mais onglet a dispatcher
commence toujours par fr ou qs

Je vous remercie de votre aide

Version excel 2003 - 2010 l'année prochaine

Dormeur74 · 2 Novembre 2012

Re : Séparer des onglets en feuille excel

Essaye cette macro.

Code:

Sub Macro1()
    Dim cheminBureau, fichier As String
    Dim objShell, objFolder, objFolderItem As Object
    Dim x, nbFeuilles As Integer
    
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(&H10)
    Set objFolderItem = objFolder.Self
    cheminBureau = objFolderItem.Path
    nbFeuilles = Sheets.Count
    
    For x = 1 To nbFeuilles
        Sheets(x).Activate
        fichier = Sheets(x).Name & ".xls"
        With ActiveWorkbook
            .SaveAs Filename:=cheminBureau & "\" & fichier
        End With
    Next x
    ActiveWorkbook.Close
End Sub

Efgé · 2 Novembre 2012

Re : Séparer des onglets en feuille excel

Bonjour FCAFE, Bonjour Dormeur74, le fil
Pas compris la même chose que Dormeur74.

VB:

Sub dispatch()
Dim chemin As String, FTest As Worksheet, F As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
chemin = CreateObject("WScript.Shell").specialFolders("Desktop")

On Error Resume Next
Set FTest = Sheets("Sauvegarde")
If Err Then
    Err.Clear
    Sheets.Add(Before:=Sheets(1)).Name = "Sauvegarde"
    Set FTest = Sheets("Sauvegarde")
End If

For Each F In Worksheets
    If F.Name <> FTest.Name And (UCase(Left(F.Name, 2)) = "FR" Or UCase(Left(F.Name, 2)) = "QS") Then
        F.Move
        With ActiveWorkbook
            .SaveAs Filename:=chemin & "\" & .ActiveSheet.Name & ".xls"
            .Close True
        End With
    End If
Next F

If Sheets.Count > 1 Then FTest.Delete

Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Cordialement

Dormeur74 · 2 Novembre 2012

Re : Séparer des onglets en feuille excel

Effectivement, j'ai pensé que FCAFE voulait éclater son classeur sur le bureau en fichiers XLS mono-feuilles.

Efgé · 2 Novembre 2012

Re : Séparer des onglets en feuille excel

Re

Dormeur74 à dit:
Effectivement, j'ai pensé que FCAFE voulait éclater son classeur sur le bureau en fichiers XLS mono-feuilles.

C'est exactement comme cela que j'ai compris la demande, mais ta proposition enregistre tout le classeur sous des noms différents. D'ailleurs, tu ne vérifies pas le nom des feuilles a ventiler...

Cordialement

FCAFE · 7 Novembre 2012

Re : Séparer des onglets en feuille excel

Bonjour, je te remercie, jai testé et ca marche cependant je souhaiterais avoir un renseignement supplementaire, dans ta macro
toutes les feuilles sont dispachés sans soucis, mais si je ne veux que cellle qui commence par f et R comment puis je faire, et si je rajoute cheminbureau\dossier jour est ce faisable ?

Merci

FCAFE · 7 Novembre 2012

Re : Séparer des onglets en feuille excel

bonjour

Ta macro marche impéccable et je t en remercie, mais j'ai besoin de savoir comment il trouve automatiquement le chemin du bureau car je voulais modifier un truc en mettant chemin bureau\dossierjour est ce faisable ? la séparation des QS et FR se fait et c'est génial. Maintenant il faut vraiment que je dispache dans un dossier différent pour ne pas avoir de problèmes. Merci de ta réponse

Merci

Dormeur74 · 7 Novembre 2012

Re : Séparer des onglets en feuille excel

Bizarre, c'est pourtant très simple :

Si tu souhaites sauvegarder les classeurs commençant par un "f" minuscule ou un "R" majuscule, tu modifies le tri comme suit :

Code:

Sub Macro1()
Sub Macro1()
    Dim cheminBureau, fichier As String
    Dim objShell, objFolder, objFolderItem As Object
    Dim x, nbFeuilles As Integer
   
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(&H10)
    Set objFolderItem = objFolder.Self
    cheminBureau = objFolderItem.Path
    nbFeuilles = Sheets.Count
   
    For x = 1 To nbFeuilles
        Sheets(x).Activate
        fichier = Sheets(x).Name & ".xls"
        ' casse respectée
        If VBA.Left(fichier, 1) = "f" Or VBA.Left(fichier, 1) = "R" Then
            With ActiveWorkbook
                .SaveAs Filename:=cheminBureau & "\" & fichier
            End With
        End If
    Next x
    ActiveWorkbook.Close
End Sub

End Sub

Mais si tu ne veux pas tenir compte de la casse, alors tu tries de cette façon-là :

Code:

Sub Macro1()
    Dim cheminBureau, fichier As String
    Dim objShell, objFolder, objFolderItem As Object
    Dim x, nbFeuilles As Integer
   
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(&H10)
    Set objFolderItem = objFolder.Self
    cheminBureau = objFolderItem.Path
    nbFeuilles = Sheets.Count
   
    For x = 1 To nbFeuilles
        Sheets(x).Activate
        fichier = Sheets(x).Name & ".xls"
        ' Casse indifférente
        If UCase(VBA.Left(fichier, 1)) = "F" Or UCase(VBA.Left(fichier, 1)) = "R" Then
            With ActiveWorkbook
                .SaveAs Filename:=cheminBureau & "\" & fichier
            End With
        End If
    Next x
    ActiveWorkbook.Close
End Sub

Pour sauvegarder tes classeurs dans un dossier ouvert sur le bureau pour cela, tu lances cette macro qui va créer le dossier et sauvegarder tes classeurs dedans.

Code:

Sub Macro1()
    Dim cheminBureau, fichier As String
    Dim objShell, objFolder, objFolderItem As Object
    Dim x, nbFeuilles As Integer
   
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(&H10)
    Set objFolderItem = objFolder.Self
    ' On crée un dossier nommé dossierjour sur le bureau
    cheminBureau = objFolderItem.Path & "\dossierjour"
    MkDir cheminBureau
    
    nbFeuilles = Sheets.Count
   
    For x = 1 To nbFeuilles
        Sheets(x).Activate
        fichier = Sheets(x).Name & ".xls"
        If UCase(VBA.Left(fichier, 1)) = "F" Or UCase(VBA.Left(fichier, 1)) = "R" Then
            With ActiveWorkbook
                .SaveAs Filename:=cheminBureau & "\" & fichier
            End With
        End If
    Next x
    ActiveWorkbook.Close
End Sub

Efgé · 7 Novembre 2012

Re : Séparer des onglets en feuille excel

Bonjour FCAFE, Dormeur74
Suite a MP
Pour créer un dossier à la date du jour sur le bureau

VB:

Sub dispatch()
Dim chemin As String, FTest As Worksheet, F As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
chemin = CreateObject("WScript.Shell").specialFolders("Desktop")
chemin = chemin & "\" & Format(Date, "yyyy_mm_dd")
If Dir(chemin) = "" Then MkDir chemin

On Error Resume Next
Set FTest = Sheets("Sauvegarde")
If Err Then
    Err.Clear
    Sheets.Add(Before:=Sheets(1)).Name = "Sauvegarde"
    Set FTest = Sheets("Sauvegarde")
End If
For Each F In Worksheets
    If F.Name <> FTest.Name And (UCase(Left(F.Name, 2)) = "FR" Or UCase(Left(F.Name, 2)) = "QS") Then
        F.Move
        With ActiveWorkbook
            .SaveAs Filename:=chemin & "\" & .ActiveSheet.Name & ".xls"
            .Close True
        End With
    End If
Next F
If Sheets.Count > 1 Then FTest.Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Cordialement

Staple1600 · 7 Novembre 2012

Re : Séparer des onglets en feuille excel

Bonjour à tous

FCAFE:
Merci à l'avenir de pas doublonner les fils
https://www.excel-downloads.com/threads/separer-des-onglets-en-feuille-excel.195336/
Parce que je me sentais seul dans celui mis en lien au dessus et je ne savais pas que ta question était déjà résolu dans ce fil...

FCAFE · 8 Novembre 2012

Re : Séparer des onglets en feuille excel

Bonjour

Désolé exuses moi

bonne soirée

Forx · 12 Février 2013

Re : Séparer des onglets en feuille excel

Bonjour,

Je rebondis sur le sujet car j'aimerais réaliser la même chose (Un peu plus simple même).

J'ai un fichier Excel contenant 63 feuilles. J'aimerais séparer ces 63 feuilles pour avoir 1 feuille par fichier Excel. Ces différentes feuilles sont nommées par Pays.

Je maîtrise les bases de Excel mais je n'ai jamais utilisé de macro ni Visual Basic. J'ai plus ou moins compris le code mais j'ai du louper une étape. Je l'ai remodifié ainsi

Code:

Sub Macro1()
    Dim cheminBureau, fichier As String
    Dim objShell, objFolder, objFolderItem As Object
    Dim x, nbFeuilles As Integer
   
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(&H10)
    Set objFolderItem = objFolder.Self
    cheminBureau = objFolderItem.Path
    nbFeuilles = Sheets.Count
   
    For x = 1 To nbFeuilles
        Sheets(x).Activate
        fichier = Sheets(x).Name & ".xlsx"

        With ActiveWorkbook
		.SaveAs Filename:=cheminBureau & "\" & fichier
		End With

    Next x
    ActiveWorkbook.Close
End Sub

Ça a plus ou moins marché, ça m'a bien crée un fichier excel bien renommé mais le problème c'est que dans chaque fichier, j'ai toutes les autres feuilles...

Est-ce qu'il est possible de n'avoir que la feuille qui m'intéresse dans chaque fichier et pas les 63 autres ?
(Après relecture, je me rend compte que ça fait pas très français cette phrase, j'espère que vous m'aurez tout de même compris )

Merci d'avance !

Staple1600 · 12 Février 2013

Re : Séparer des onglets en feuille excel

Bonjour à tous

Forx1
Un exemple simple que je te laisse adapter
(à tester sur un classeur déjà enregistré)
Code VBA:
Sub a()
Dim ws As Worksheet, nf$
For Each ws In Worksheets
nf = ws.Name
ws.Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & nf & ".xls"
ActiveWorkbook.Close True
Next ws
End Sub

PS: Il est de coutume de créer sa discussion pour ses propres questions
(plutôt que de la poser dans le fil d'un autre membre)
Et ce pour la compréhension du fil.

EDITION: Bonjour Efgé, tu as raison c'est mieux avec des endives

Efgé · 12 Février 2013

Re : Séparer des onglets en feuille excel

Bonjour Forx et bienvenu sur le forum,
Au plus simple (en particulier pour trouver l'adresse du bureau:

VB:

Sub dispatch_Une_Par_Une()
Dim chemin As String, F As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
chemin = CreateObject("WScript.Shell").specialFolders("Desktop")
For Each F In Worksheets
    F.Copy
    With ActiveWorkbook
        .SaveAs Filename:=chemin & "\" & .ActiveSheet.Name & ".xlsx"
        .Close True
    End With
Next F
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Cordialement

EDIT Salut Staple

Re EDIT Oui, comme j'avais mis les petits plats dans les grands, j'avais prévu les légumes

Forx · 12 Février 2013

Re : Séparer des onglets en feuille excel

Merci pour la rapidité de vos réponses, je vais tester tout ça !

Pour le topic, c'est surtout pour pas qu'on me reproche si je créé un nouveau post que je n'ai pas fait l'effort de chercher.

Sur d'autres forums on m'aurait reproché d'avoir créé un post alors qu'un autre était ouvert pour une question similaire :/

Séparer des onglets en feuille excel

FCAFE

XLDnaute Nouveau

Pièces jointes

Dormeur74

XLDnaute Occasionnel

Efgé

XLDnaute Barbatruc

Dormeur74

XLDnaute Occasionnel

Efgé

XLDnaute Barbatruc

FCAFE

XLDnaute Nouveau

FCAFE

XLDnaute Nouveau

Dormeur74

XLDnaute Occasionnel

Efgé

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

FCAFE

XLDnaute Nouveau

Forx

XLDnaute Nouveau

Staple1600

XLDnaute Barbatruc

Efgé

XLDnaute Barbatruc

Forx

XLDnaute Nouveau

Discussions similaires