Séparer des onglets en feuille excel

  • Initiateur de la discussion Initiateur de la discussion FCAFE
  • Date de début Date de début
F

FCAFE

XLDnaute Nouveau
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
 

Pièces jointes

Trier par date Trier par votes
Dormeur74

Dormeur74

XLDnaute Occasionnel
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
 
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
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
 
Dernière édition:
Vote positif 0 Vote négatif
F

FCAFE

XLDnaute Nouveau
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
 
Vote positif 0 Vote négatif
F

FCAFE

XLDnaute Nouveau
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
 
Vote positif 0 Vote négatif
Dormeur74

Dormeur74

XLDnaute Occasionnel
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
 
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
F

Forx

XLDnaute Nouveau
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 :D )

Merci d'avance !
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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 ;)
 
Dernière édition:
Vote positif 0 Vote négatif
Efgé

Efgé

XLDnaute Barbatruc
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 :D
 
Dernière édition:
Vote positif 0 Vote négatif
F

Forx

XLDnaute Nouveau
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 :/
 
Vote positif 0 Vote négatif

Discussions similaires

H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
363
Phil69970
Phil69970
C
  • Question Question
XL 2016 Automatiser et synthétiser les informations d'un tableau Excel d'un onglet 1 vers des onglets 2 et 3
Réponses
14
Affichages
308
chris63
C
rastafouette
  • Question Question
Microsoft 365 "concatener" certaines colonnes d'onglets
2
Réponses
15
Affichages
757
Phil69970
Phil69970
C
  • Question Question
Microsoft 365 RESOLU - Compter des valeurs dans des colonnes qui contiennent 2 données
Réponses
8
Affichages
304
Cousinhub
Cousinhub
C
  • Question Question
XL 2016 accès feuilles masquées par bouton
2
Réponses
26
Affichages
393
vgendron
vgendron
A
  • Résolu(e)
Microsoft 365 programme VBA pour "importer" les valeurs de certaines cellules d'une autre feuille appartenant à une ligne que j'identifie par un n°
2
Réponses
27
Affichages
525
arnomorize
A
C
  • Question Question
Autres macros Excel
3 4 5
Réponses
63
Affichages
2 K
Cheminotbelgiantrain
C
F
  • Résolu(e)
Microsoft 365 copier coller des colonnes en fonction de la valeur d'une cellule
Réponses
8
Affichages
657
loloboc
L
L
  • Résolu(e)
Microsoft 365 Input Duplication feuille en masse
2
Réponses
20
Affichages
1 K
LuanaDDC
L
V
  • Question Question
XL 2021 avoir des données dans plusieurs onglets en fonction de plusieurs conditions
Réponses
5
Affichages
548
mapomme
mapomme
T
  • Question Question
XL 2010 Séparer des onglets pour impression PDF dans un dossier
Réponses
14
Affichages
928
kiki29
kiki29
Julie-F
  • Question Question
XL 2016 Base puis création de fichiers multiples sous une présentation similaire
Réponses
5
Affichages
663
Julie-F
Julie-F
Jelose
  • Question Question
XL 2021 Dupliquer un tableau sur différents onglets pour un mois donné
Réponses
2
Affichages
529
Jelose
Jelose
S
  • Résolu(e)
Microsoft 365 [RESOLU] Excel : Calcul de prix en fonction d'un type
Réponses
4
Affichages
228
JHA
J
M
  • Résolu(e)
XL 2013 Planning perpétuel Excel
2
Réponses
17
Affichages
633
Manutela
M
MBax
  • Résolu(e)
Microsoft 365 Extraction d'informations sur différents onglets en partant d'une base de données
Réponses
7
Affichages
528
MBax
MBax
Nicolas JACQUIN
  • Résolu(e)
XL 2021 Combiner plusieurs macros en 1 seule fonction
2 3 4
Réponses
58
Affichages
2 K
Nicolas JACQUIN
Nicolas JACQUIN
L
  • Résolu(e)
Microsoft 365 Cumul progressif en PowerQuery
Réponses
7
Affichages
608
oguruma
oguruma
jgav
  • Résolu(e)
XL 2016 Incrémenter des formules dans une feuille, en la copiant et la renommant en même temps
Réponses
9
Affichages
543
jgav
jgav
M
  • Résolu(e)
Power Query Convertir un fichier PdF en Excel
Réponses
9
Affichages
1 K
Merlin258413
M

Membres actuellement en ligne

13 membres et 315 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 285
Messages
2 118 022
Membres
113 412
dernier inscrit
Casi18