EXCEL ANNEE 2017
L'heure est venue de vous presenter
Une excel et bonne annee 2017 !
De la part de toute l equipe de VeriTi
| Re : Besoin d'aide pour macro listing mise a jour auto |
Objet : Re : Besoin d'aide pour macro listing mise a jour auto par maximebart sur 24/07/2014 14:42:07 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 |