[VBA] Ouvrir un nouveau classeur si pas ouvert

J

jeanBaptiste

XLDnaute Junior
Bonjour le forum,

J'ai fait une macro qui me permet de copier les données d'une feuille dans une feuille que je créé dans un autre classeur ("test") que j'ouvre. Le problème est que je veux pouvoir faire cette macro plusieurs fois de suite sans devoir à chaque fois le fermer car sinon j'ai le message qui me dit que le classeur est déjà ouvert.

J'ai essayer de faire une condition qui l'active si il est déjà ouvert et l'ouvre si il ne l'ai pas mais sans succès.

De plus si c'était possible de me dire comment faire pour que la feuille que je créé soit toujours en premier.

Je vous joint mes deux classeur pour que ce soit plus claire.

Merci

Cordialement,

jeanBaptiste
 

Pièces jointes

  • Test.xlsx
    15.6 KB · Affichages: 65
  • Test.xlsx
    15.6 KB · Affichages: 76
  • Traitement de données.xlsm
    38 KB · Affichages: 82
  • Traitement de données.xlsm
    38 KB · Affichages: 90
Trier par date Trier par votes
Papou-net

Papou-net

XLDnaute Barbatruc
Re : [VBA] Ouvrir un nouveau classeur si pas ouvert

Bonjour JeanBaptiste,

Voici un exemple de code fonctionnel:

Code: 
Sub Exportationfeuil()
Dim Nom As String, Existe, EstOuvert, Fich, nFich
Set xlApp = CreateObject("Excel.Application")

'Vérifie dans le répertoire de ce classeur si le fichier "Test.xlsx" est ouvert
Existe = Dir(ThisWorkbook.Path & "\Test.xlsx")
If Existe = "" Then
    Set nFich = xlApp.Workbooks.Add
    nFich.SaveAs ThisWorkbook.Path & "\Test.xlsx"
    Else
    EstOuvert = False
    For Each Fich In Workbooks
      If Fich.Name = "Test.xlsx" Then
        EstOuvert = True
        Exit For
      End If
    Next
    If EstOuvert = False Then Workbooks.Open (ThisWorkbook.Path & "\Test.xlsx")
End If

'On copie la Feuil1 puis dans une InputBox on demande le nom de la nouvelle feuille que l'on va créer dans notre
'autre classeur où l'on va stocker les tableaux
ThisWorkbook.Worksheets("Feuil1").Range("A1:M" & Rows.Count).Copy
    
Nom = InputBox("Entrez le nom de la machine", "Création d'une nouvelle feuille")
If Nom <> "" Then
'        Dim wb As Workbook
  Dim ws As Worksheet
'        'fichier = "V:\Amelioration continue\Macro indicateur\Test.xlsx"
'        Set wb = Workbooks.Open
'        Set ws = wb.Worksheets(1)
  Workbooks("Test.xlsx").Sheets.Add before:=Sheets(1)
  ActiveSheet.Name = Nom
  With ActiveSheet.Range("A1")
    .PasteSpecial Paste:=xlPasteValues
    .PasteSpecial Paste:=xlPasteColumnWidths
    .PasteSpecial Paste:=xlPasteFormats
    .Application.CutCopyMode = False
  End With
End If
End Sub
Cette procédure créé unh fichier dans le meme répertoire que le classeur qui la contient. Si tu désires le placer dans un autre répertoire, il suffit de remplacer ThisWorkbook.Path par une chaîne en toutes lettres.

Cordialement.
 
Vote positif 0 Vote négatif
J

jeanBaptiste

XLDnaute Junior
Re : [VBA] Ouvrir un nouveau classeur si pas ouvert

Bonjour Papou,

Ton code fonctionne mais lorsque je veux faire une deuxième exportation c'est ma feuil1 de mon classeur source qui devient la destination je pense que ça viens de cette partie de code :

Code: 
ActiveSheet.Name = Nom

car ActiveSheet pointe toujours sur la Feuil1 et pas sur la feuille que l'on vient de créer.

Cordialement,

jeanBaptiste
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : [VBA] Ouvrir un nouveau classeur si pas ouvert

Bonjour jeanBaptiste, Papou-net,

jeanBaptiste à dit:
Le problème est que je veux pouvoir faire cette macro plusieurs fois de suite sans devoir à chaque fois le fermer car sinon j'ai le message qui me dit que le classeur est déjà ouvert.
Cliquez pour agrandir...

Ce n'est pas du tout un problème, voyez cette macro :

Code: 
Sub Exportationfeuil()
Dim w As Worksheet, nom$
Set w = ActiveSheet
1 nom = InputBox("Entrez le nom de la machine", "Création d'une nouvelle feuille", nom)
If nom = "" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
With Workbooks.Open(ThisWorkbook.Path & "\Test.xlsx")
  If .Name = "" Then MsgBox "Fichier 'Test.xlsx' introuvable !", 48: Exit Sub
  If IsError(.Sheets(nom)) Then Else _
    If MsgBox("La feuille '" & nom & "' a déjà été créée, voulez-vous la remplacer ?", 36) _
      = 7 Then .Close: GoTo 1
  .Sheets(nom).Delete
  .Sheets.Add Before:=.Sheets(1)
  .Sheets(1).Name = nom
  If .Sheets(1).Name <> nom Then .Close: MsgBox "Caractère interdit !", 48: GoTo 1
  w.[A:M].Copy .Sheets(1).[A1]
  w.Rows("1:2").Copy .Sheets(1).[A1] 'pour la hauteur des lignes de titres
  .Save
  Application.ScreenUpdating = True
  If MsgBox("La feuille a été créée, voulez-vous fermer ce fichier ?", 36) = 6 Then .Close
  GoTo 1 'facultatif
End With
End Sub
Edit : GoTo 1 (facultatif) pour revenir sur l'InputBox à la fin.

A+
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : [VBA] Ouvrir un nouveau classeur si pas ouvert

Re,

On peut aussi fermer systématiquement le fichier "Test.xlsx" et revenir sur l'InputBox :

Code: 
Sub Exportationfeuil()
Dim w As Worksheet, nom$
Set w = ActiveSheet
1 nom = InputBox("Entrez le nom de la machine", "Création d'une nouvelle feuille", nom)
If nom = "" Then Exit Sub
'Application.ScreenUpdating = False 'en commentaire sur Excel 2013
Application.DisplayAlerts = False
On Error Resume Next
With Workbooks.Open(ThisWorkbook.Path & "\Test.xlsx")
  If .Name = "" Then MsgBox "Fichier introuvable !", 48: Exit Sub
  If IsError(.Sheets(nom)) Then Else _
    If MsgBox("La feuille '" & nom & "' a déjà été créée, voulez-vous la remplacer ?", 36) _
      = 7 Then .Close: GoTo 1
  .Sheets(nom).Delete
  .Sheets.Add Before:=.Sheets(1)
  .Sheets(1).Name = nom
  If .Sheets(1).Name <> nom Then .Close: MsgBox "Caractère interdit !", 48: GoTo 1
  w.[A:M].Copy .Sheets(1).[A1]
  w.Rows("1:2").Copy .Sheets(1).[A1] 'pour la hauteur des lignes de titres
  .Save
  .Sheets(1).Cells.Interior.ColorIndex = 17
  Application.ScreenUpdating = True
  Application.Wait Now + 5 / 86400 'le temps de bien voir la feuille créée...
  .Close
  GoTo 1
End With
End Sub
Edit : sur Excel 2013 il faut mettre Application.ScreenUpdating = False en commentaire, à voir sur 2007...

A+
 
Dernière édition:
Vote positif 0 Vote négatif
Papou-net

Papou-net

XLDnaute Barbatruc
Re : [VBA] Ouvrir un nouveau classeur si pas ouvert

RE:

Arf, je n'avais pas testé la répétition de la macro.

Voici donc comment modifier le code pour que ça fonctionne:

Code: 
Sub Exportationfeuil()
Dim Nom As String, Existe, EstOuvert, Fich, nFich
Set xlApp = CreateObject("Excel.Application")

'Vérifie dans le répertoire de ce classeur si le fichier "Test.xlsx" est ouvert
Existe = Dir(ThisWorkbook.Path & "\Test.xlsx")
If Existe = "" Then
    Set nFich = xlApp.Workbooks.Add
    nFich.SaveAs ThisWorkbook.Path & "\Test.xlsx"
    Else
    EstOuvert = False
    For Each Fich In Workbooks
      If Fich.Name = "Test.xlsx" Then
        EstOuvert = True
        Exit For
      End If
    Next
    If EstOuvert = False Then Workbooks.Open (ThisWorkbook.Path & "\Test.xlsx")
End If

'On copie la Feuil1 puis dans une InputBox on demande le nom de la nouvelle feuille que l'on va créer dans notre
'autre classeur où l'on va stocker les tableaux
ThisWorkbook.Worksheets("Feuil1").Range("A1:M" & Rows.Count).Copy
Nom = InputBox("Entrez le nom de la machine", "Création d'une nouvelle feuille")
If Nom <> "" Then
  Dim ws As Worksheet
  With Workbooks("Test.xlsx")
    .Sheets.Add before:=Sheets(1)
    .Sheets(1).Name = Nom
    With .Sheets(1).Range("A1")
      .PasteSpecial Paste:=xlPasteValues
      .PasteSpecial Paste:=xlPasteColumnWidths
      .PasteSpecial Paste:=xlPasteFormats
      .Application.CutCopyMode = False
    End With
  End With
End If
End Sub
As-tu testé la solution de job75 (je le salue au passage)? Tu peux lui faire confiance, c'est un "pro" et son code est un peu plus concis que le mien.

Cordialement.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : [VBA] Ouvrir un nouveau classeur si pas ouvert

Re,

En fait pour conserver Application.ScreenUpdating = False sur Excel 2013 il suffit d'exécuter 2 fois DoEvents :

Code: 
Sub Exportationfeuil()
Dim w As Worksheet, nom$
Set w = ActiveSheet
1 nom = InputBox("Entrez le nom de la machine", "Création d'une nouvelle feuille", nom)
If nom = "" Then Exit Sub
Application.ScreenUpdating = False 'en commentaire sur Excel 2013
Application.DisplayAlerts = False
On Error Resume Next
With Workbooks.Open(ThisWorkbook.Path & "\Test.xlsx")
  If .Name = "" Then MsgBox "Fichier introuvable !", 48: Exit Sub
  If IsError(.Sheets(nom)) Then Else _
    If MsgBox("La feuille '" & nom & "' a déjà été créée, voulez-vous la remplacer ?", 36) _
      = 7 Then .Close: GoTo 1
  .Sheets(nom).Delete
  .Sheets.Add Before:=.Sheets(1)
  .Sheets(1).Name = nom
  If .Sheets(1).Name <> nom Then .Close: MsgBox "Caractère interdit !", 48: GoTo 1
  w.[A:M].Copy .Sheets(1).[A1]
  w.Rows("1:2").Copy .Sheets(1).[A1] 'pour la hauteur des lignes de titres
  .Save
  .Sheets(1).Cells.Interior.ColorIndex = 17
  Application.ScreenUpdating = True
  DoEvents: DoEvents 'nécessaire sur Excel 2013
  Application.Wait Now + 5 / 86400 'le temps de bien voir la feuille créée...
  .Close
  GoTo 1
End With
End Sub
A+
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : [VBA] Ouvrir un nouveau classeur si pas ouvert

Bonjour le fil, le forum,

Je joins les fichiers pour les 2 solutions.

Bonne journée.
 

Pièces jointes

  • Test.xlsx
    13 KB · Affichages: 69
  • Traitement de données(2).xlsm
    48.2 KB · Affichages: 75
  • Traitement de données(1).xlsm
    48 KB · Affichages: 75
  • Test.xlsx
    13 KB · Affichages: 65
  • Traitement de données(2).xlsm
    48.2 KB · Affichages: 70
  • Traitement de données(1).xlsm
    48 KB · Affichages: 72
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Re : [VBA] Ouvrir un nouveau classeur si pas ouvert

Re,

Nettement plus compliqué avec indexation éventuelle du nom et tri des onglets dans "Test.xlsx".

Nouveaux fichiers joints.

A+
 

Pièces jointes

  • Traitement de données - tri des onglets(1).xlsm
    49.3 KB · Affichages: 79
  • Traitement de données - tri des onglets(2).xlsm
    47.8 KB · Affichages: 61
  • Test.xlsx
    17.3 KB · Affichages: 70
  • Test.xlsx
    17.3 KB · Affichages: 79
Vote positif 0 Vote négatif
J

jeanBaptiste

XLDnaute Junior
Re : [VBA] Ouvrir un nouveau classeur si pas ouvert

Bonjour,

Je pensais avoir répondu mais job m'a fait remarquer que non, j'ai testé toute vos solutions et les ai fait essayé à la personne intéressé et il se trouve que c'est la méthode de Papou qui convient le mieux
Je vous remercie pour toute ces solutions que vous m'avez apporté.

Cordialement jeanBaptiste
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Résolu(e)
XL 2021 fermeture du classeur après apple d'un userform d'un autre classeur ouvert
Réponses
2
Affichages
87
farid
F
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Protection automatique des nouvelles feuilles
Réponses
6
Affichages
136
Phil69970
Phil69970
Electron24
  • Question
Microsoft 365 Classeur disparu
2
Réponses
19
Affichages
535
VIARD
V
F
  • Résolu(e)
Microsoft 365 Code vba pour Ouvrir un fichier et copier son contenu dans un classeur existant à partir de la boite de dialogue
Réponses
3
Affichages
269
Faroyo
F
T
  • Résolu(e)
XL 2019 Logger les modifications faites sur un autre classeur
Réponses
5
Affichages
165
ThierryP
T
A
  • Question
Microsoft 365 Partage d'un classeur avec accès limité à un onglet pour chaque utilisateur
Réponses
1
Affichages
138
piga25
piga25
_l_ours
  • Résolu(e)
XL 2016 Copier un onglet dans un nouveau classeur excel et l'enregistrer
Réponses
3
Affichages
159
sylvanu
sylvanu
L
  • Question
Microsoft 365 Macro choisir onglet à exporter dans un nouveau classeur
Réponses
5
Affichages
345
l.et.lilou
L
vgendron
  • Question
XL 2021 Fonctions et _xlfn...
Réponses
2
Affichages
530
vgendron
vgendron
Usine à gaz
  • Question
XL 2021 Besoin de modifier Workbooks("classeur1") selon le classeur ouvert
3 4 5
Réponses
64
Affichages
2 K
TooFatBoy
TooFatBoy

Membres actuellement en ligne

4 membres et 73 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
312 104
Messages
2 085 349
Membres
102 869
dernier inscrit
radyreth