Re : Besoin d'aide pour macro listing mise a jour auto

Publié par maximebart le 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