Enregistre un onglet sous une nouveau classeur dans un même dossier

[wrap food]

bonjour,

J'ai classeur dans le qu'elle j'ai plusieurs onglets .
j'aimerais faire une macro qui copie l'onglet actif dans un nouveau claseur .
Mais j'aimerai que le nouveau classeur soit mis dans le même dossier que le classeur d'origine.
si cela est possible sans que dans la macro je soit obliger de mettre le chemin.
les opérateurs pouvan mettre le dossier d'origine a n'importe qu'elle endrot de leur disc ..

En faite je dois envoyer le dossier d'origine par mail et apres les utilisateurs le mettent ou ils veulent.

merci pour vos conseille par avance

 

[Pierrot93]

Re : Enregistre un onglet sous une nouveau classeur dans un même dossier

Bonjour,

essaye ceci :

ActiveSheet.Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Nuveauclasseur"

bonne journée
@+

 

[wrap food]

Re : Enregistre un onglet sous une nouveau classeur dans un même dossier

Merci Pierrot93

désolé , j'aurais besoin d'affiner ma demande.
J'aimerais que le mon du ficheir corresponde à la cellule A 142
est ce que le code qui suit est le bon?

Private Sub CommandButton2_Click()
ActiveSheet.Copy
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Range("A142") & ".xls"
End Sub

et j'aimerais que le nouveau fichier n'est pas de macro

si vous avez la solution

par avance merci

 

[Yaloo]

Re : Enregistre un onglet sous une nouveau classeur dans un même dossier

Bonsoir Wrap food, Pierrot, le forum,

Plutôt comme ça.

Private Sub CommandButton2_Click()
 ActiveSheet.Copy
 ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Range("A142") & ".xls"
End Sub

Si tu n'as pas de macro dans ta feuille, tu n'en aura pas dans ton nouveau classeur.

A+

 

[Nero]

Re : Enregistre un onglet sous une nouveau classeur dans un même dossier

Désolé de ressortir ce topic mais j'aimerais adapter ce code pour que cette fois ci la macro copie tous les onglets selectionnés dans des classeurs séparés dans un meme dossier.

 

[Yaloo]

Re : Enregistre un onglet sous une nouveau classeur dans un même dossier

Bonsoir Nero,

Il aurait été mieux de recréer un post à toi, mais ce n'est pas grave.

Que veux-tu faire et comment ?

Le nom du futur classeur se trouve dans la feuille ?

"Dans un même dossier" --> ça veux dire quoi ? A chaque fois que tu enregistre ça crée un dossier spécifique ?

A te relire

Martial

 

[Nero]

Re : Enregistre un onglet sous une nouveau classeur dans un même dossier

Bonjour Yaloo,

Alors voici concrétement ce que je souhaite faire, je met un fichier template avec la macro d'extract pour vous aider.

Donc en gros voilà le process:

On place le fichier là où on veut (dans un dossier vide ce sera plus clair).
Ensuite je voudrais que lorsque je lance la macro, cela extrait les onglets (séparéments) et viens simplement créer chaque onglet du fichier initial dans le même dossier où se trouve le fichier source.

Actuellement la macro marche uniquement pour l'onglet qui est actif.
Le must serait que la macro soit capable d'extraire uniquement les onglets que l'on souhaite (par exemple que les rouges)

C'est un peu mieux expliqué comme ça?

 

[Yaloo]

Re : Enregistre un onglet sous une nouveau classeur dans un même dossier

Bonsoir Nero, le forum,

Avec la macro ci-dessous, ça doit faire ce que tu demande :

Sub Enregistrement()
Dim Sh As Worksheet
For Each Sh In Worksheets 'Pour tous les onglets(sheet)
If Sh.Tab.ColorIndex = 3 Then 'Si la couleur de l'onglet est rouge alors
  Sh.Copy 'On copie l'onglet
  Application.DisplayAlerts = False 'S'il y a une alerte, il n'y a pas de message apparent
  ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Sh.Name & ".xlsx" 'On enregistre dans le répertoire du fichier source
  ActiveWorkbook.Close 'On ferme le nouveau classeur
End If
Next Sh ' On passe à l'onglet suivant
End Sub

A te relire

Martial

 

[Nero]

Re : Enregistre un onglet sous une nouveau classeur dans un même dossier

Bravo Yaloo!!!

C'est exactement ça!!
Bon j'ai finalement fais quelques modifs par rapport à mon fichier (genre le titre du fichier est lié à une cellule et la couleur à prendre est le noir)

Sub Extraction()
Application.ScreenUpdating = False
Dim Sh As Worksheet
For Each Sh In Worksheets 'Pour tous les onglets(sheet)
If Sh.Tab.ColorIndex = 1 Then 'Si la couleur de l'onglet est noire alors
  Sh.Copy 'On copie l'onglet
  Application.DisplayAlerts = False 'S'il y a une alerte, il n'y a pas de message apparent
  ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Range("B1") & ".xls" 'On enregistre dans le répertoire du fichier source avec comme titre le contenu de la cellule B1
  ActiveWorkbook.Close 'On ferme le nouveau classeur
End If
Next Sh ' On passe à l'onglet suivant
Application.ScreenUpdating = True
End Sub

Maintenant je vais essayer de rajouter une barre de progression histoire de rendre le truc plus classe.

Merci encore à toi Martial