veriti site des amis d'excel

Bonjour tout le monde, j'ai un soucis je dois rendre pour dans 2semaines un tout petit classeur..

Bon j'explique mon soucis, j'ai en ma possession :
- le classeur avec pleins de numéros de câbles
- la feuille a remplir type
- la demande du client

Le classeur et la fiche type sont dans le premier Excel ci-joint.
La demande du client (anglais) :
- chaque ligne noir sur l'Excel est un câble
- Chaque cellule verte doit être rempli automatiquement
- faire une feuille pour chaque câble

J'ai pensé à utiliser une macro mais je n'y connait absolument rien du tout...
La macro doit détecter le TAG du câble, créer une nouvelle feuille depuis avec l'apparence de la feuille type et doit remplir automatique toutes les cellules verte.

De plus je dois insérer un système de validation qui fonctionne comme ceci :
- le premier bouton : peut cliquer dessus quand l'utilisateur le souhaite.
- la seconde boite : peut cliquer dessus uniquement quand le premier bouton a été validé.
Si au passage on peut mettre un système de changement de couleur (du type ca passe au vert quand c'est validé) je suis preneur aussi.

Donc j'ai commencé à réfléchir à tout ceci (second classeur)
Sauf que j'arrive tout simplement pas à créer la boucle permettant de faire tout les câbles en une seule fois...

Si une personne pourrai m'expliquer comment je peux faire ca me rendrai un immense service, je vais continuer à chercher sur internet entre-temps.
Merci :)

ps : si par hasard vous sauriez ensuite mettre un bouton pour refaire la macro si le fichier change et ajouter les feuilles manquantes ce serai un petit bonus intéressant ;)

Bon j'ai trouvé comment faire tout cela, ce qu'il me manque c'est d'integrer une fonction qui me permettrai d'ignores les cellules vides dans la colonne TAG, la misa a jour auto, et la mise a jour auto.

Public Sub MacroLast()
Dim NameSheet As String
Dim Sheetx As String
Dim y As Integer
Dim x As Integer
Dim Trouvé As Boolean
Dim deli As Long, i As Long

10 Trouvé = False
20 y = 1

30 Do
'Boucle tant que le compteur "x" est inférieur à 200
40 Do While x < 20
'Appele la macro de test
50 ActiveCell.Select
60 If ActiveCell.Value = "" Then
70 ActiveCell.Offset(1, 0).Select
80 Else
'incrémente "x" de 1 à chaque fois
90 x = x + 1
100 ActiveCell.Select
110 Selection.Copy
120 Sheets.Add after:=Worksheets(Worksheets.Count)
130 NameSheet = "Exemple" + CStr(y)
140 ActiveSheet.Name = NameSheet
150 Sheetx = ActiveSheet.Name
160 Range("A1").Select
170 ActiveSheet.Paste
180 Sheets("Feuil1").Select
190 ActiveCell.Offset(0, 1).Select
200 Application.CutCopyMode = False
210 Selection.Copy
220 Sheets(Sheetx).Select
230 Range("B1").Select
240 ActiveSheet.Paste
250 Sheets("Feuil1").Select
260 ActiveCell.Offset(0, -1).Select
270 ActiveCell.Offset(1, 0).Select
280 y = y + 1
290 End If
'vérifie le contenue de la cellule dans la colonne
300 If Cells(x, 1) = "FINISH" Then
'Attribut la valeur Vrai si le mot est trouvé
310 Trouvé = True
'Anticipe la sortie de la boucle
320 Exit Do
330 End If
340 Loop
350 Loop Until Trouvé = True Or x = 20
End Sub

Trouvé pour ignorer cellules vide, mais message d'erreur il continues a défiler après la dernière ligne d'arrêt, sans créer de feuilles bien sur, donc j'ai désactiver le défilement de l'écran et il me met plus qu'un message d'erreur de dépassement de capacité à la fin.

Public Sub MacroLast()
Dim NameSheet As String
Dim Sheetx As String
Dim y As Integer
Dim x As Integer
Dim Trouvé As Boolean
Dim deli As Long, i As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
10 Trouvé = False
20 y = 1
30 Do
'Boucle tant que le compteur "x" est inférieur à 200
40 Do While x < 230
'Appele la macro de test
50 ActiveCell.Select
60 If ActiveCell = "" Then
70 ActiveCell.Offset(1, 0).Activate
y = y + 1
100 Else
'incrémente "x" de 1 à chaque fois
110 x = x + 1
120 ActiveCell.Select
130 Selection.Copy
140 Sheets.Add after:=Worksheets(Worksheets.Count)
150 NameSheet = "Exemple" + CStr(y)
160 ActiveSheet.Name = NameSheet
170 Sheetx = ActiveSheet.Name
180 Range("A1").Select
190 ActiveSheet.Paste
200 Sheets("Feuil1").Select
210 ActiveCell.Offset(0, 1).Select
220 Application.CutCopyMode = False
230 Selection.Copy
240 Sheets(Sheetx).Select
250 Range("B1").Select
260 ActiveSheet.Paste
270 Sheets("Feuil1").Select
280 ActiveCell.Offset(0, -1).Select
290 ActiveCell.Offset(1, 0).Select
y = y + 1
End If
'vérifie le contenue de la cellule dans la colonne
320 If Cells(x, 1) = "FINISH" Then
'Attribut la valeur Vrai si le mot est trouvé
330 Trouvé = True
'Anticipe la sortie de la boucle
340 Exit Do
350 End If
360 Loop
370 Loop Until Trouvé = True Or x = 230
Application.ScreenUpdating = True
End Sub

Bonjour,

Ta demande date un peu et est donc sans doute obsolète...

Reviendras tu ? Si oui, il me semble qu'il manque les fichiers joints annoncés.

Bon courage.