Juillet 2013 : A l'occasion du 10eme anniversaire de VeriTi, j'ai décide de réparer et de remettre en ligne le site, avec une nouvelle version plus structurée tout en gardant les mêmes fichiers 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
Date de publication : 24/07/2014 09:48
Information
Bienvenue sur le forum VeriTi,
Une équipe de bénévoles se tient à votre disposition pour vous venir en aide. N'hésitez pas à poser votre question en rapport avec Excel sur le forum Excel, et une question générale en rapport avec le site sur le forum VeriTi
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