Création de feuille à partir de la boucle for...next

[gant1801]

Bonjour,

Je cherche à réaliser une macro possédant les caractéristiques suivantes:
- Pour i allant de 1 à 100
- Si la feuille "AA i" (AA 12 par exemple) existe, alors aller dans cette feuille
- Ajouter le texte "OK" en cellule A1
- Si cette feuille n'existe pas, il faut la créer

Merci de votre aide

 

[mapomme]

Re : Création de feuille à partir de la boucle for...next

Bonsoir gant1801,

Essayez ce code:

Sub deUNaCent()
Dim i As Integer
  On Error GoTo deUNaCent_NoSheet_i

  For i = 1 To 100
    Sheets("AA " & i).Range("A1") = "OK"
  Next i
  Exit Sub

deUNaCent_NoSheet_i:
  If i = 1 Then
    Sheets.Add after:=Sheets(Sheets.Count)
  Else
    Sheets.Add after:=Sheets("AA " & i - 1)
  End If
  ActiveSheet.Name = "AA " & i
  ActiveSheet.Range("A1") = "OK"  'supprimer cette ligne le cas échéant
  Resume Next
End Sub

Si les nouvelles feuilles ne doivent pas comporter "OK" en cellule A1, supprimer la ligne mentionnée.

 

[gant1801]

Re : Création de feuille à partir de la boucle for...next

Le code marche merci!
Je vais tâcher de l'adapter à mon cas précis et je reviens vers vous en cas de soucis...

 

[mapomme]

Re : Création de feuille à partir de la boucle for...next

(re)Bonsoir,

Une version avec tri des 100 feuilles "AA 1" à "AA 100".

Sub deUNaCent()
Dim i As Integer
  Application.ScreenUpdating = False
  On Error GoTo deUNaCent_NoSheet_i

  For i = 1 To 100
    Sheets("AA " & i).Range("A1") = "OK"
  Next i
  
  'tri des 100 feuilles
  For i = 2 To 100
    Sheets("AA " & i).Move after:=Sheets("AA " & i - 1)
  Next i
  Application.ScreenUpdating = True
  Exit Sub

deUNaCent_NoSheet_i:
  'création de la feuille et affectation du nom
  Sheets.Add
  ActiveSheet.Name = "AA " & i
  ActiveSheet.Range("A1") = "OK"  'supprimer cette ligne le cas échéant
  Resume Next
End Sub

 

[gant1801]

Re : Création de feuille à partir de la boucle for...next

(Re)bonsoir,
J'ai essayé d'adapter sur mes besoins, mais avec quelques difficultés
J'aimerais que la fonction ne s'exécute que si il est possible de sélectionner le critère "A" dans le champ "Immobilisation" de mon TCD

Sub Choix_immobilisation()
Dim A As Long
On Error GoTo Choix_immobilisation_NoSheet_A

For A = 2000000 To 3000000
If Not testchamp(A) Is Nothing Then
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Immobilisation").PivotItems(A).Visible = True
ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Immobilisation").CurrentPage = A
Workbooks.Open Filename:="Justif IEC 31-12-12 CUN 2010.xls"
Sheets("IEC AIAB " & A).Select
End If
Next A
Exit Sub

Choix_immobilisation_NoSheet_A:
If i = 2000000 Then
Sheets.Add after:=Sheets(Sheets.Count)
Else
Sheets.Add after:=Sheets("IEC AIAB " & A - 1)
End If
ActiveSheet.Name = "IEC AIAB " & A
End Sub


La fonction test champ étant une fonction adaptée de la proposition de Pierrot93 et permettant de déterminer si le critère existe ou non

Function testchamp(pf As String) As PivotItem
On Error Resume Next
Set testchamp = ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Immobilisation").PivotItems(pf)
End Function


Le code ainsi généré ne fonctionne pas et j'ai beau me tirailler dans tous les sens je ne vois pas comment y remédier...
Hormis cela, j'ai vu que vous aviez inclus une version pour ordonner les feuilles, je vous en remercie c'est très intéressant et je n'y avais pas pensé.
Si vous avez des éléments de réponse à mon problème, voir même la solution je suis tout ouïe!

Merci du temps que vous consacrez à mon problème
Ps: Comment faites vous pour indiquer le code vba dans une sorte de "note"?