Copy-Delete condition

[alan]

Bonjour,

Je recherche une macro qui pourrait m'effectuer ceci dans l'ordre:
1) Copier/coller speciale toutes les feuilles de mon classeur pour eliminer les formules
2) une fois ceci fait, ensuite effacer toutes les feuilles dont le nom n'est pas uniquement un chiffre entre 1 et 99 (Attention certaines feuilles pourraient etre uniquement des graphiques)

Merci pour votre aide

 

[alan]

Re : Copy-Delete condition

Une petite idee sur comment je pourrai creer ca...j'ai deja un bout de code que Robert avait commence....

Sub copy()
Dim sh As Worksheet 'déclare la variable sh
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'masque les messages Excel
'Nb = ActiveWorkbook.Sheets.Count

For Each sh In Sheets 'boucle sur tous les onglets du classeur
sh.Activate 'sélectionne l'onglet

If Len(sh.Name) > 2 Then 'condition : si le nombre de caractères du nom de l'onglet est supérieur à 2
sh.Delete 'supprime l'onglet
GoTo suite 'passe à l'onglet suivant via l'étiquette "suite"
End If 'fin de la condition

On Error Resume Next
ActiveSheet.UsedRange.Select
Selection.copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
suite: 'étiquette
Next sh 'prochaine onglet du classeur
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True 'affiche les messages Excel
End Sub

 

[Staple1600]

Re : Copy-Delete condition

Bonjour


A tester

Sub test()
Dim WS As Worksheet
For Each WS In Worksheets
Application.DisplayAlerts = False
If Not WS.Name Like "*[0-9]*" Then
WS.Delete
End If
Next
For Each WS In Worksheets
WS.UsedRange.Cells.Value = WS.UsedRange.Cells.Value
Next
End Sub

Il faut qu'il y ait au moins une feuille avec un nom sans chiffres.

 

[alan]

Re : Copy-Delete condition

Merci Staple pour ce code,

Qques problemes se posent cependant:
1) Si ma feuille est un graphique uniquement, il bloque. J'ai refait tourner ton code apres avoir enleve tous les graphs et ca marche.
2) J'ai l'impression qu'il me garde aussi les feuilles ou un numero est present (par ex: Jan08...)
3) Est il possible de changer l'ordre d'action cad:
Au lieu de copier feuille 1 et effacer si pas bon numero puis passer a feuille 2 etc...j'aimerai qu'il me copie toutes les feuilles d'abord puis qu'il applique l'effacement selon critere.
En effet, les feuilles que je veux garder sont a l'origine des formules dont les donnees sont sur les feuilles qui seront effacees par la suite.
Merci d'avance

 

[Staple1600]

Re : Copy-Delete condition

Re


Pour tenir compte des graphiques
(avec une fonction VBA personnalisée d'un compère Excelien d'outre atlantique)

Sub test_III()
Dim WS As Worksheet
'équivalent collage spécial
For Each WS In Worksheets
WS.UsedRange.Cells.Value = WS.UsedRange.Cells.Value
Next
Application.DisplayAlerts = False
For Each WS In Worksheets
'teste la feuille est un graphique ou pas
If Not IsChart(WS) Then
If Not WS.Name Like "*[0-9]*" Then
WS.Delete
End If
End If
Next
End Sub

Public Function IsChart(sh) As Boolean
'auteur: mdmackillop
    Dim tmpChart As Chart
    On Error Resume Next
    Set tmpChart = Charts(sh.Name)
    IsChart = IIf(tmpChart Is Nothing, False, True)
End Function

 

[alan]

Re : Copy-Delete condition

Re Jean-Marie,

Sur mon fichier original, il me renvoie un message d'erreur 1004:
WS.UsedRange.Cells.Value = WS.UsedRange.Cells.Value
Que cela peut il bien signifier dans mon classeur? (ca fonctionne bien avec un classeur plus simple)

De plus, tu mets:
For Each WS In Worksheets
'teste la feuille est un graphique ou pas
If Not IsChart(WS) Then
If Not WS.Name Like "*[0-9]*" Then
WS.Delete

Que dois je rajouter si je veux dire:
For Each WS In Worksheets
If IsChart(WS) And
If Not WS.Name Like "*[0-9]*" Then
WS.Delete

Cad si c un graphique je l'efface obligatoirement et si la feuille ne remplit pas la condition [0-9], je l'efface aussi...

Merci encore

 

[Staple1600]

Re : Copy-Delete condition

Re

Ton classeur original contient combien de feuilles?


Une petite modif qui change beaucoup
Test OK sur Excel 2000

Sub test_IV()
Dim ws As Variant
'équivalent collage spécial
For Each ws In Worksheets
ws.UsedRange.Cells.Value = ws.UsedRange.Cells.Value
If Not ws.Name Like "*[0-9]*" Then
ws.Delete
End If
Next
Application.DisplayAlerts = False
For Each ws In [COLOR=DarkRed][B]Sheets[/B][/COLOR]
'efface les graphiques (Feuille de graphique)
'pas les graphiques incorporés
If IsChart(ws) Then
ws.Delete
End If
Next
End Sub

Public Function IsChart(sh) As Boolean
'auteur: mdmackillop
    Dim tmpChart As Chart
    On Error Resume Next
    Set tmpChart = Charts(sh.Name)
    IsChart = IIf(tmpChart Is Nothing, False, True)
End Function
Sub testt()
MsgBox IsChart(Feuil2)
End Sub

Une macro pour supprimer les graphiques incorporées

Sub SuppressionGRAPHIQUES_INCORPORES()
Dim ws As Worksheet
Dim G_Obj As ChartObject
For Each ws In ThisWorkbook.Worksheets
For Each G_Obj In ws.ChartObjects
G_Obj.Delete
Next
Next
End Sub

 

[alan]

Re : Copy-Delete condition

Re JM,

Mon fichier original contient ~ 80 feuilles.
La macro passe pas sur ce fichier, tjrs meme message d'erreur. c surement la disposition de ce fichier qu'il n'aime pas....
Sur le fichier simple, il m'efface bien tout ce que je veux mais c comme il avait oublie de coller les valeurs dans la page voulue...du coup je me retrouve avec des #REF,
je te joints mon fichier tres simple de test...

 

[Staple1600]

Re : Copy-Delete condition

Re


Avec ces modif
(déplacement de la ligne en rouge)
(et décomposition en trois étapes)

Sub test_IV()
Dim ws As Variant
Dim WSH As Worksheet
[COLOR=Red]Application.DisplayAlerts = False[/COLOR]
'équivalent collage spécial (etape1)
For Each WSH In Worksheets
WSH.UsedRange.Cells.Value = WSH.UsedRange.Cells.Value
Next
For Each WSH In Worksheets
'suppression des feuilles (etape 2)
If Not WSH.Name Like "*[0-9]*" Then
WSH.Delete
End If
Next
For Each ws In Sheets
'efface les graphiques (Feuille de graphique) (étape3)
'pas les graphiques incorporés
If IsChart(ws) Then
ws.Delete
End If
Next
End Sub

Après exécution de la macro, il ne reste que la feuille 45 et elle ne contient plus de formules.

 

[alan]

Re : Copy-Delete condition

Merci JM,

Desole, j'ai pas encore pu la tester...petits problemes d'ordi...je reviens vers toi ce weekend pour confirmer si j'arrive a regler tout ca...
Ciao

 

[alan]

Re : Copy-Delete condition

Bon Jm et forum,

Impossible de faire partir mon pu....d'excel 2007 a la maison..deviens fou surtout qu'il flotte dans ce pu..de pays! heureusement que je demenage au pays des tulipes et du gouda dans un mois! ne sais pas si ca sera meilleurs pcq on a aussi un tmps de mer...en bretagne!
Je compatis et reviens vers toi quand je reviens au boulot (avec mon excel 2003 et non 2007)
Merci de ta patience...
Ciao
PS: Chanceux d'etre en Bretagne............................

 

[alan]

Re : Copy-Delete condition

Re JM,

Ca marche parfaitement sur mon fichier simple mais toujours un probleme sur mon fichier original. Cependant, si j'enleve une feuille particuliere de ce fichier (ou bizzarement il n'y a pas de formules), ca marche aussi. Comprends pas trop....
Derniere question:
Comment faut il que je change:
If Not WS.Name Like "*[0-9]*" Then

Si je ne veux garder que les feuilles a 2 chiffres uniquement...tous les noms composes de chiffres et lettres en meme temps seront effaces.
Merci en tout cas pour ce code efficace....

 

[Staple1600]

Re : Copy-Delete condition

Re

essayes cette macro sur une copie de ton classeur original.

(pour n'avoir que les valeurs et non plus les formules)

Sub valeurs_seules()
Dim ws As Worksheet
Dim cell As Range
For Each ws In Worksheets
For Each cell In ws.UsedRange
If Not IsEmpty(cell) And cell.HasFormula Then
cell.Value = cell.Value
End If
Next
Next
End sub

Que se passe-t'il?

 

[alan]

Re : Copy-Delete condition

Pas grand chose...apres 10min, il est toujours en train de bosser..enfin je ne sais pas si il se passe beaucoup de choses en fait, il m'a plus l'air bloque.
Je suis oblige de l'arreter par le gestionnaire des taches...
Pour le nom, ca marche impecc. Me reste a savoir pourquoi il ne marche pas si je n'enleve pas cette feuille particuliere...je vais faire des essais...
Merci encore

 

[Staple1600]

Re : Copy-Delete condition

Re


et comme cela

Sub valeurs_II()
Dim ws As Worksheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim cell As Range
For Each ws In Worksheets
For Each cell In ws.UsedRange
If Not IsEmpty(cell) And cell.HasFormula Then
cell.Value = cell.Value
End If
Next
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub