annee 2017

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

Image 1

Bienvenue

sur le site des amis d'Excel

excel.veriti.net ou fr

Image 2

Musee

Visitez le "Musee VeriTi" 24h/24 - 7j/7, des "pepites" vous y attendent

Voir la suite
Image 3

Hommage

Thierry POURTIER alias 'Ti'
s'en est alle brutalement le samedi 13 novembre 2010...

Voir la suite
Image 4

Historique

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

Voir la suite

Membre

+ Enregistrement
Message du rapport :*
Code de Confirmation*
0 + 5 = ?  
Entrez le résultat de l'expression
Maximum de tentatives que vous pouvez essayer : 10
 

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
Copyright 2013 Powered by XOOPS © 2001-2013