Suppression onglets donnés

Bonsoir tout le monde,

j'ai besoin d'un conseil car je m'arrache les cheveux depuis qq jour sur un sujet.

Je vous explique....

Depuis un fichier "A.xlsm" j'active une macro qui va ouvrir un fichier "B.xlsm", qui copie un onglet "toto" (le fichier "B" ne contient qu'un seul onglet) et qui, avant de le coller (et c'est là mon problème) va venir vérifier si le fichier "A " n'a pas déjà cet onglet.
Si c'est le cas alors il efface l'onglet dans le fichier "A", sinon il le colle.
J'ai débuté le code mais je n'arrive pas à lui dire que la vérification de l'existence de l'onglet doit se faire dans le fichier "B"

J'ai ça dans un module:

Sub FusionFichiers()

Dim Feuille As Worksheet
'identifier les fichiers et les onglets

chemin = ThisWorkbook.Path
fichier = Dir(chemin & "\*20*.xlsm") ' Premier fichier
Destination = chemin & "\Synthèse.xlsm"

Do While fichier <> ""
Filename = chemin & "\" & fichier
Workbooks.Open Filename
Windows(fichier).Activate
nomOnglet = ActiveSheet.Name

'check si onglet existe
For Each Feuille In ActiveWorkbook.Worksheets
For Each Img In Feuille.Pictures
Img.Delete
Next Img
Next Feuille
'Supprime le bouton d'envoi dispo par mail (inutile ici)


fichier = Dir ' Fichier suivant
Loop

End Sub

Sub Tri_onglets()
Application.ScreenUpdating = False
Dim iSheets%, i%, j%
iSheets = Sheets.Count

For i = 1 To iSheets - 1
For j = i + 1 To iSheets
If Sheets(j).Name < Sheets(i).Name Then
Sheets(j).Move Before:=Sheets(i)
End If
Next j
Next i
Application.ScreenUpdating = True
Sheets("Preparation").Move Before:=Sheets(1)
End Sub

Pouvez vous m'aider svp?

Merci beaucoup

Bonjour,

Voici un essai avec une fonction :

Sub FusionFichiers()

dim wbbase as workbook, wbnv as workbook
Dim Feuille As Worksheet
'identifier les fichiers et les onglets

set wbbase = thisworkbook
chemin = ThisWorkbook.Path
Destination = chemin & "\Synthèse.xlsm"

fichier = Dir(chemin & "\*20*.xlsm") ' Premier fichier
Do While fichier <> ""
    Filename = chemin & "\" & fichier
    set wbnv = Workbooks.Open(Filename)
    nomOnglet = wbnv.sheets(1).Name
    if FeuilleExiste(wbbase, nomOnglet) then
        application.displayalerts = false
        wbbase.sheets(nomOnglet).delete
        application.displayalerts = true 
    end if
    wbnv.sheets(1).copy after:=wbbase.sheets(wbbase.sheets.count)
    fichier = Dir ' Fichier suivant
Loop

End Sub

function FeuilleExiste(Classeur as workbook, NomFeuille$) as boolean
on error resume next
FeuilleExiste = Classeur.Sheets(NomFeuille).Index
end function

Cdlt,

J'ai une erreur:

Type d'arugment ByRef incompatible.

Le compilateur pointe la variable nomOnglet sur la ligne:

If FeuilleExiste(wbbase, nomOnglet) Then

j'ai pu corriger entre temps mais je souhaite que les pages du fichier source soient copiées aussi dans le fichier de destination

Oui, il fallait définir la variable nomOnglet...

Que voulez-vous faire exactement ?

J'envoie à plusieurs personnes un fichier à remplir.

Chaque personne me renvoie son propre fichier renseigné.

Plutot que de devoir ouvrir chaque fichier je souhaite à l'aide d'une maccro copier l'onglet unique de chaque fichier dans un fichier de synthèse.

Tous les fichiers seront dans le même répertoire.

Mon souhait est que lorsque je lance la maccro dans mon fichier de synthèse je puisse vérifier que l'onglet n'existe pas déjà.

Sil existe alors je l'efface dans le fichier de synthèse puis je copie la dernière version du fichier reçu par cette personne.

Sil n'existe pas alors je copie simplement l'onglet du fichier source vers le ficher synthèse.

Je ne souhaite avoir que la dernière version pour chaque personne donc un seul onglet par personne dans mon fichier de synthèse

Je vais regarder avec plus d'attention mais ce qui est censé se passer déjà... Est-ce que "Synthèse.xlsm" est le classeur exécutant, thisworkbook ?

Est-il nécessaire de supprimer la feuille et de la recopier ? Ne pourrait-on pas copier toutes les cellules sur les feuilles déjà existantes (quand elles existent bien sûr) ?

Cdlt,

Oui tout à fait

Merci beaucoup

Est-il nécessaire de supprimer la feuille et de la recopier ? Ne pourrait-on pas copier toutes les cellules sur les feuilles déjà existantes (quand elles existent bien sûr) ?

Voici une proposition de code (pas de grand changement à signaler) :

Sub FusionFichiers()

dim wbdest as workbook, wb as workbook
dim ws as worksheet
dim nomwb$, nomws$

chemin = ThisWorkbook.Path & "\"
set wbdest = thisworkbook

nomwb = Dir(chemin & "*20*.xlsm") ' Premier fichier
Do While nomwb <> ""
    set wb = Workbooks.Open(chemin & nomwb)
    set ws = wb.sheets(1)
    nomws = ws.Name
    if FeuilleExiste(wbdest, nomws) then
        application.displayalerts = false
        wbdest.sheets(nomws).delete
        application.displayalerts = true 
    end if
    ws.copy after:=wbdest.sheets(wbdest.sheets.count)
    wb.close true
    nomwb = Dir ' Fichier suivant
Loop

End Sub

function FeuilleExiste(Classeur as workbook, NomFeuille$) as boolean
on error resume next
FeuilleExiste = Classeur.Sheets(NomFeuille).Index
end function

si bien sur une copie des cellules reviendrait au même

Je ferai un test avec ce code demain

En attendant un grand merci et une bonne soirée

D'accord, et bien dans ce cas, avec l'option copie de cellules (qui évite d'avoir à décider plus ou moins au hasard de l'emplacement de la feuille à copier lorsqu'elle existait déjà) :

Sub FusionFichiers()

dim wbdest as workbook, wb as workbook
dim ws as worksheet
dim nomwb$, nomws$

chemin = ThisWorkbook.Path & "\"
set wbdest = thisworkbook

nomwb = Dir(chemin & "*20*.xlsm") ' Premier fichier
Do While nomwb <> ""
    set wb = Workbooks.Open(chemin & nomwb)
    set ws = wb.sheets(1)
    nomws = ws.Name
    if FeuilleExiste(wbdest, nomws) then
        ws.cells.copy destination:=wbdest.sheets(nomws).cells
    else
        ws.copy after:=wbdest.sheets(wbdest.sheets.count)
    end if
    wb.close true
    nomwb = Dir ' Fichier suivant
Loop

End Sub

function FeuilleExiste(Classeur as workbook, NomFeuille$) as boolean
on error resume next
FeuilleExiste = Classeur.Sheets(NomFeuille).Index
end function

Merci, très bonne soirée à toi également !

On s'approche du but cependant il reste une énigme pour moi, j'ai beau chercher depuis 1h et je ne parviens pas à trouver la faille.

J'ai dit plus haut que chaque classeur ne contenait qu'un seul onglet ce qui est faux, il y en a un visible mais un autre qui s'appelle "Personnels" et qui est caché et verrouillé pour les utilisateurs.

Forcément quand je lance la macro qui répond parfaitement au besoin (un grand merci à toi) chaque fichier est parcouru et le code plante parce que l'onglet "Personnels" est aussi testé mais comme il est protégé ça ne se passe pas bien.

Il faudrait ajouter une condition:

Pour tous les onglets dans la feuille sauf celui qui s'appelle "Personnels"

Ca semble simple dit comme ça mais j'ai des erreurs au compilateur sur les types de variable et je ne parviens pas à les résoudre

Bonjour Micka,

Oui, comme tu as dit qu'il n'y avait qu'un seul onglet, j'ai mis .sheets(1) dans le code mais si ce premier onglet est masqué alors il est possible de remplacer uniquement :

set ws = wb.sheets(1)
'par
set ws = wb.activesheet 'comme c'était le cas dans ton code initial

Sinon :

Do While nomwb <> ""
    set wb = Workbooks.Open(chemin & nomwb)
    for each ws in wb.worksheets
        if ws.visible = true then 'ou if ws.name <> "Personnels" then
            nomws = ws.Name
            if FeuilleExiste(wbdest, nomws) then
                ws.cells.copy destination:=wbdest.sheets(nomws).cells
            else
                ws.copy after:=wbdest.sheets(wbdest.sheets.count)
            end if
            exit for
        end if
    next ws
    wb.close true
    nomwb = Dir ' Fichier suivant
Loop

On boucle sur chaque feuille du classeur et dès qu'une d'entre elles répond à la condition (visibilité ou nom), on fait la copie puis on sort de la boucle (la sortie n'est pas nécessaire ici mais on sait jamais).

Cdlt,

Ca fonctionne parfaitement, je te remercie mille fois
Ca parait si simple quand c'est écrit, j'ai tellement cherché sans trouver ce qui ne semble pas si compliqué quand on a du talent ;-)

Si je peux abuser encore un peu.....ce n'est pas urgent.....quand je lance la macro j'ai pour le moment 3 fichiers à scruter mais je peux en avoir jusqu'à 80 et la macro met du temps, est il possible selon toi de l'optimiser et de rendre invisible aussi les ouvertures et fermetures des fichiers à analyser?

Merci encore

Nickel ! Je suis content !

Oui, c'est normal, il y a certains réflexes qui viennent avec le temps, et à force de résoudre les mêmes problèmes, ça viendra très vite, t'inquiète !

Désolé mais je ne suis pas du tout calé en optimisation du temps d'exécution sachant que, là, tu ouvres quand même 80 fichiers. Déjà tu peux essayer de rajouter les lignes :

application.screenupdating = false 'désactive maj ecran
application.visible = false 'rend excel invisible (d'ailleurs je ne sais pas si desactiver maj ecran est utile dans ce cas)

'le code

application.visible = true
application.screenupdating = true

On pourrait aussi copier uniquement les valeurs des feuilles plutôt que les cellules (mais s'il y a des formules et des formats, c'est compromis).

Mais je pense que tu devrais créer un nouveau sujet, tu obtiendrais meilleures réponses.

Cdlt,

je n'ai laissé que la ligne Application.ScreenUpdating = False pour que Excel se ferme à la fin de la macro.

Il me reste un peu de boulot et je vais ouvrir un nouveau post mais ton code fait le boulot à merveille.

Je te remercie mille fois et te souhaite une très bonne journée.

Micka