Empecher l'envoie d'une erreur si l'onglet existe déjà
Bonjour,
Je cherche à mettre en place un système ou plutôt une sécurité qui m'évite d'avoir une erreur quand je demande à Excel de mettre à jour les valeurs de mes onglets.
Par exemple une macro qui parcourrait mon classeur et si elle trouve un onglet qui existe déjà elle ne le recrée pas ( car du coup erreur), et passe à la suite.
Sub Macro()
Dim nomFeuille As String
Dim monFichier As String
Dim wb As Workbook
Dim chemin As String
Dim i As Integer
Set wb = Workbooks(ThisWorkbook.Name)
chemin = ThisWorkbook.Path & "\Test\"
monFichier = Dir(chemin & "*.xlsx", vbNormal)
Do While monFichier <> ""
'Ici je cr?e un onglet pour chaque nom de fichier dans mon dossier
onglet = Split(Split(monFichier, "-")(2), "_")(0)
Sheets.Add After:=Sheets(Sheets.Count)
With Sheets(Sheets.Count)
.Name = onglet
.Activate
End With
wb.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = onglet
End If
monFichier = Dir
Loop
End Sub
Merci d'avance
Bonjour,
Je n'ai pas bien compris ta demande mai j'essai:
Sub Macro()
Dim nomFeuille As String
Dim monFichier As String
Dim wb As Workbook
Dim chemin As String
Dim i As Integer
Set wb = Workbooks(ThisWorkbook.Name)
chemin = ThisWorkbook.Path & "\Test\"
monFichier = Dir(chemin & "*.xlsx", vbNormal)
Do While monFichier <> ""
'Ici je cr?e un onglet pour chaque nom de fichier dans mon dossier
onglet = Split(Split(monFichier, "-")(2), "_")(0)
For Each sh In ThisWorkbook.Sheets
If sh.Name = onglet Then
GoTo SUIVANT
End If
Next
Sheets.Add After:=Sheets(Sheets.Count)
With Sheets(Sheets.Count)
.Name = onglet
.Activate
End With
'wb.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = onglet 'Comprend pas pourquoi tu en créer une autre.
SUIVANT:
monFichier = Dir
Loop
End Sub
End Sub
Bonjour et merci pour ta réponse.
Dans l'idée c'est exactement ce que je cherche à faire, sauf que j'aurais besoin d'un petit quelque chose en plus.
Je copie un Template d'un onglet présent initialement dans mon fichier (nommé : "Template") et je le recopie dans chaque des onglets.
J'aimerais que la macro à chaque lancement, si elle trouve les mêmes noms d'onglets, réactualise les valeurs à l'intérieur des fichiers correspondant.
Par exemple si un onglet nommé TestA possède dans la cellule A1 la valeur 12 et que dans le fichier d'origine je remplace la valeur de la cellule A1 par 11, quand je vais relancer la macro, je pourrais voir la valeur 11 dans l'onglet TestA
Sub Macro()
Dim nomFeuille As String
Dim monFichier As String
Dim wb As Workbook
Dim chemin As String
Dim i As Integer
Set wb = Workbooks(ThisWorkbook.Name)
chemin = ThisWorkbook.Path & "\test2\"
monFichier = Dir(chemin & "*.xlsx", vbNormal)
Do While monFichier <> ""
'Ici je cr?e un onglet pour chaque nom de fichier dans mon dossier
onglet = Split(Split(monFichier, "-")(2), "_")(0)
For Each sh In ThisWorkbook.Sheets
If sh.Name = onglet Then
GoTo SUIVANT
End If
Next
Sheets.Add After:=Sheets(Sheets.Count)
With Sheets(Sheets.Count)
.Name = onglet
.Activate
End With
Sheets("Template").Range("A1:AH127").Copy Destination:=wb.Sheets(onglet).Range("A1")
nomFeuille = onglet
num_onglet = num_onglet + 1
Sheets(8 + num_onglet).Activate
Sheets(8 + num_onglet).Range("A1").FormulaR1C1 = nomFeuille
SUIVANT:
monFichier = Dir
Loop
'Je sais pas ? quoi ?a sert
Application.ScreenUpdating = True 'Facultatif
BoEcran = Application.ScreenUpdating = BoEcran
BoBarre = Application.DisplayStatusBar = BoBarre
iCalcul = Application.EnableEvents = iCalcul
BoEvent = Application.EnableEvents = BoEvent
BoSaut = ActiveSheet.DisplayPageBreaks = BoSaut
End Sub
N'hésite pas à me dire si je manque encore de précision.
Merci encore pour ton aide.
Bonjour,
Une proposition :
Sub MAJ_fiches()
Dim nomFeuille As String, monFichier As String, chemin As String
Dim sh As Sheet, num_onglet As Integer
chemin = ThisWorkbook.Path & "\test2\"
monFichier = Dir(chemin & "*.xlsx", vbNormal)
Do While monFichier <> ""
'Ici je crée un onglet pour chaque nom de fichier dans mon dossier
nomFeuille = Split(Split(monFichier, "-")(2), "_")(0)
For Each sh In ThisWorkbook.Sheets
If sh.Name = nomFeuille Then
'Remplacer nom de la feuille "Template" si besoin
Sheets("Template").Range("A1:AH127").Copy Destination:=sh.Range("A1")
GoTo SUIVANT
End If
Next
'Si on arrive ici, c'est que la feuille nomFeuille n'existe pas encore
Sheets.Add After:=Sheets(Sheets.Count) 'Devient la feuille active
ActiveSheet.Name = nomFeuille
Sheets("Template").Range("A1:AH127").Copy Destination:=Sheets(onglet).Range("A1")
num_onglet = num_onglet + 1
Sheets(8 + num_onglet).Range("A1") = nomFeuille
SUIVANT:
monFichier = Dir
Loop
End Sub
Bonjour et merci pour ton message.
Dans mon Template j'utilise de cellules fusionnées, je rencontre donc le problème à cette ligne (ligne14)
Sheets("template").Range("A1:AH127").Copy Destination:=sh.Range("A1")
Aurais-tu une solution de substitution ?
Merci d'avance.
Chacun de tes fichiers possède une seule feuille que tu veux centralisé dans un seul fichier c'est bien cela ?
Si c'est le cas tu vas devoir ouvrir chaque fichier pour en extraire les données.
Et au lieu de mettre a jour les feuilles, ne serai ce pas plus pratique de supprimer l'ancienne et de la remplacer directement ?
Du style :
Sub Centraliser_Données()
'Déclare les variables classeurs
Dim ThisWb As Workbook
Dim Wb As Workbook
'Déclare les variables fichiers
Dim Chemin As String
Dim Fichier As String
'On défini le ThisWb sur ce fichier
Set ThisWb = ThisWorkbook
'On initie le premier fichier
Chemin = ThisWorkbook.Path & "\Test\"
Fichier = Dir(Chemin & "*.xlsx", vbNormal)
'On désactive les pop-up et l'affichage temps réel
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Pour chaque fichier xlsx
Do While Fichier <> ""
'On retrouve le nom de la feuille
onglet = Split(Split(Fichier, "-")(2), "_")(0)
'Si elle existe dans ce fichier on la supprime
For Each Sh In ThisWorkbook.Sheets
If Sh.Name = onglet Then
Sh.Delete
End If
Next
'On ouvre le fichier
Workbooks.Open Chemin & Fichier
'On défini Wb sur le fichier fraichement ouvert
Set Wb = Workbooks(Fichier)
'On copie la feuille dans le fichier central
Wb.ActiveSheet.Copy after:=ThisWb.ActiveSheet
'On renomme la feuille
ActiveSheet.Name = onglet
'On ferme le fichier apres avoir récupérer la feuille
Wb.Close
'On passe au fichier suivant
Fichier = Dir
Loop
'On réactive les pop-up et affichage temps réel
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Bonjour à tous les deux.
Veuillez m'excuser pour le délais de ma réponse, mais j'ai essayé de me dépatouiller de mon coté avec ce que vous m'avez envoyé.
Concernant l'idée d'aller les chercher et les ouvrir un par un, c'est vraiment contraignant pour moi puisque je devrais faire ça avec plus de 60 fichiers différents...
Ce que j'ai réussi à faire en partant du code de Pedro22 c'est pourvoir ajouter d'autre onglet correspondant à d'autre fichier dans mon dossier sans que ça "plante". Maintenant le souci que j'ai, si j'ajoute un nouveau fichier dans mon dossier pour l'ajouter à mon fichier Excel source(ou tourne la macro), il va bien copier le Template de l'onglet "Template" mais sans aller créer un lien en récupérant les valeurs présentes dans le fichier dans le dossier, comme la macro le fait lors de la première exécution ( sans nouveau onglet après "Template")
Voici mon code :
Sub qsd()
Dim nomFeuille As String, monFichier As String, chemin As String
Dim num_onglet As Integer
Set wb = Workbooks(ThisWorkbook.Name)
chemin = ThisWorkbook.Path & "\test2\"
monFichier = Dir(chemin & "*.xlsx", vbNormal)
Do While monFichier <> ""
'Ici je cr?e un onglet pour chaque nom de fichier dans mon dossier
nomFeuille = Split(Split(monFichier, "-")(2), "_")(0)
For Each sh In ThisWorkbook.Sheets
If sh.Name = nomFeuille Then
'Remplacer nom de la feuille "Template" si besoin
'Sheets("T15").Range("A1:AH127").Copy Destination:=sh.Range("A1")
GoTo SUIVANT
End If
Next
'Si on arrive ici, c'est que la feuille nomFeuille n'existe pas encore
Sheets.Add After:=Sheets(Sheets.Count) 'Devient la feuille active
ActiveSheet.Name = nomFeuille
Sheets("T15").Range("A1:AH127").Copy Destination:=Sheets(nomFeuille).Range("A1")
num_onglet = num_onglet + 1
Sheets(8 + num_onglet).Activate
Sheets(8 + num_onglet).Range("A1").FormulaR1C1 = nomFeuille
'MsgBox "vérif"
'Recuperation des donn?es des FIT_MECH
For i = 8 To 154
Select Case nomFeuille
Case "T1"
'Temps 'Ici je crée un lien pour aller récupérer les valeurs dans l'onglet Test1 de mon fichier, de mon dossier.
j = 3
Cells(i - 4, j - 2) = "='" & chemin & "[" & monFichier & "]Test1'!R" & i & "C" & j:
Case Else: 'Tout ce qui n'est pas l'onglet T1
'Temps
j = 3
Cells(i - 4, j - 2) = "='" & chemin & "[" & monFichier & "]Test'!R" & i & "C" & j:
End Select
Next
'Permet de passer au fichier suivant en vidant le nomFicheir
SUIVANT:
monFichier = Dir
Loop
End Sub
Merci une nouvelle fois pour votre aide !