Extraire feuille identique plusieurs fois

[Etn]

Bonjour,

Cela fait des heures que je suis bloqué dans ma macro (qui je suis sûr est toute simple mais encore trop difficile pour moi).

Mon objectif est d'extraire la feuille tableau du classeur travail plusieurs fois, en changeant à chaque fois le nom du fruit (la liste est dans la feuille "donnees").

Voila où j'en suis, mais j'ai toujours ce message d'erreur "Next sans For", pourtant j'ai bien un For donc je ne comprends pas..

Sub Copier()
 Dim objWorkbookCible As Workbook
 Dim objworkbooksource As Workbook
 Set objworkbooksource = ActiveWorkbook
 For i = 1 To Range("nbfruits")
 With ThisWorkbook.Sheets("donnees")
  Range("fruit") = Cells(6 + i, 1)
  Worksheets("tableau").Copy
  Range("A1:S49").Select
  Selection.Copy
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  :=False, Transpose:=False
  Next i
End Sub

En bonus si c'est possible de renommer chaque nouvelle feuille en nom du fruit (je l'ai nommé "fruit" dans le gestionnaire de nom) ce serait parfait.

Merci d'avance pour votre aide,

Etn

 

[gosselien]

Bonjour,

un truc en passant : quand tu fait une boucle For/Next If/endif ou With/ End with etc etc

il est plus facile pour bien finir la boucle d'écrire

if
[return] et insérer ici tes lignes et décaler les lignes en installant ceci par exemple: http://www.oaltd.co.uk/Indenter/Default.htm
for
[return]
next
endif

P.

 

[Jauster]

Hello,

Le code n'est pas très propre et il y a surement mieux, mais il fait le travail. Seul problème, la source de la Data Validation doit uniquement sélectionner les fruits et aucune cellule vide sinon la macro créer une feuille en plus (qu'il est possible de supprimer à la main

Sub Copier()
Dim wb As Workbook
Dim inputRange As Range
Dim c As Range
Dim wsD As Worksheet
Dim wsT As Worksheet

Set wb = ThisWorkbook
Set wsD = wb.Worksheets("Donnees")
Set wsT = wb.Worksheets("Tableau")

With wsT
Set inputRange = Evaluate(.Range("D3").Validation.Formula1)
    For Each c In inputRange
    On Error GoTo EH
        .Range("fruit") = c
        .Copy After:=Sheets(Sheets.Count)
        ActiveSheet.Name = .Range("fruit")
    Next c
End With

EH:
End Sub

 

[Etn]

Bonjour Gosselien, Jauster,

@gosselien : J'essaierai d'installer cela sur mon ordi, depuis le boulot c'est pas très recommandé

@Jauster : Super cela fonctionne presque parfaitement. J'ai oublié de le préciser mais je souhaiterais que les feuilles générées soient dans un nouveau classeur (et donc que le "classeur travail" ne change pas).
Et pour la feuille vide générée pas de probleme.

Merci pour votre aide en tout cas !