Bonjour Bleck, @Xtoph, Zon et le Forum.
Bon alors ça c'est l'exemple du fil à ne pas faire...
Mister Bleck "Hola"
Et Oh là là aussi :-(
Si tu lis un tant soit peu la Charte de ce forum tu verrais que tu nous fais un sbinz ici.
Si j'ai rédigé l'article 2 §2 c'est justement pour éviter ce genre de fil...
Car ce matin, j'ai été obligé de me faire des recherches depuis le 30 avril pour essayer de comprendre quel problème tu avais... C'est franchement pas cool... et c'est vraiment parceque j'ai lu que mon ami @Xtof@ me demandait ici, sinon je n'aurai pas perdu de temps sur ce fil.
Pour le Problème de Dépassement, je pense que Zon à raiZon !! (héhéhé).
En fait je n'ai pas ouvert les multiples exemples de Xtof, mais en regardant le dernier en date "Exemple7.xls" du post de @Xtof@ du 07-05-03 09:32
Lien supprimé je me rends compte de deux choses :
1) Le Module1 est vraiment très inspiré du code que j'ai écrit pour la démo pour DJ-Run
Fil numéro 28900
2) Dans le Module2 @Xtoph@ nous a fait un petit mixte crapuleux des déclaration de variables !!!
En effet le module2 avec mes commentaires :
=============================================================
Option Explicit
Dim WS As Worksheet
Dim rep As String '<<<< NON NON NON : vbYes = 6 ET vbNo = 7 donc BYTE SUFFIT
Sub Debut()
rep = MsgBox("Voulez vous supprimer les valeur d'origine de la feuille inicial?", vbYesNo)
If rep = vbYes Then '<<<< ON PEUT ECRIRE If rep = 6 Then
'pour ici vu le résultat d'un clear total.........
Range("A65536").End(xlUp).End(xlToRight).Select
Range(Selection, Cells(1)).ClearContents
'>>>>>>>>>>>>>>>>>> Cells.clear ' Suffit amplement !!! lol
End If
For Each WS In Worksheets
If WS.Name <> "Inicial" Then
WS.Range("A2:K" & WS.Range("A65536").End(xlUp).Row).Copy _
Destination:=Worksheets("Inicial").Range("A" & _
Range("A65536").End(xlUp).Row + 1)
End If
Next WS
Clean
End Sub
Sub Clean()
Dim WS As Worksheet
Dim L As Byte '<<<<< NON NON NON As Long ou éventuellement As Integer !!!!!!!!!
'PUIS J'ARRETE LA CORRECTION ICI.........
'CAR APRES REFLEXION CETTE MACRO N'A PAS LIEU D'EXISTER !!! LoL !!!
L = Range("I65536").End(xlUp).Row
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each WS In ActiveWorkbook.Worksheets
If WS.Name = "Inicial" Then
Else: WS.Columns("A:I").ClearContents
End If
Next WS
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
=============================================================
Et maintenant ma version du module2 :
=============================================================
Option Explicit
Sub Debut()
Dim WS As Worksheet
Dim rep As Byte
Dim Test As String
rep = MsgBox("Voulez vous supprimer les valeur d'origine de la feuille inicial?", vbYesNo)
If rep = 6 Then
'ICI J'AI AJOUTE UN TEST QUE JE PENSE TRES UTILE !! HOLA !!!
Test = Sheets("Inicial").Range("B2") & " " & Sheets("Inicial").Range("F2")
If IsEmpty(Sheets(Test).Range("A2")) Then
MsgBox "Le report sur les feuilles n'a pas été fait au préalable.... Danger !!!" & _
vbCrLf & "Vous ne pouvez lancer ce code sous risque de perdre toute vos données", vbCritical, "WARNING"
Exit Sub
End If
Cells.Clear
End If
For Each WS In Worksheets
If WS.Name <> "Inicial" Then
WS.Range("A2:I" & WS.Range("A65536").End(xlUp).Row).Copy _
Destination:=Worksheets("Inicial").Range("A" & _
Range("A65536").End(xlUp).Row + 1)
WS.Columns("A:I").ClearContents
End If
Next WS
End Sub
=============================================================
Voilà j'ai profité de la réduction des instruction pour y ajouter un ptit test qui me semble bien utile....
Voilà Mister Bleck, tu ne devrais plus avoir de message, même en Espagnol !! lol (Enfin j'espère !)
Bon Dimanche à vous tous et à ceux/celles qui passeront par ce fil.
@+Thierry
