Bonjour Bertrand, Pat, Guigui , le Forum
Bon ça va être long ce Post, je le sens !!!
Alors je vais essayer de profiter de la mise en page pour faire clair et précis :
Lastrow = .Range('A32767').End(xlUp).Row
En effet comme Bertrand a correctement expliqué, il s’agit de partir d’une Cellule en bas de page (Ici donc La Cellule ' A32767 ') et de remonter jusqu’à la première cellule non-vide rencontrée. Et donc la Variable Integer ' LastRow ' prendra la valeur de la Ligne (Row) de cette première cellule non-vide rencontrée en partant du bas…
Pourquoi partir du Bas et pas du Haut ? Et bien pour avoir la certitude de ne pas tomber sur une cellule Vide qui se trouverait malencontreusement sur le parcours si on partait du Haut…
Si je fais tourner ceci sur un tableau comme suit :
LastRow = Range('A1').End(xlDown).Row
Colonne A
Line 1 Toto
Line 2 Lolo
Line 3 Lulu
Line 4
Line 5 Zaza
Line 6 Titi
Line 7 Riri
Et bien LastRow sera la Ligne 3...
Pour la remarque de Pat '
Ensuite ligne 32767 ou 65536 ne change rien AMHA ! '
Queneni, en fait si j’ai mis 32767, c’est simplement parce que c’est la Limite de ma Variable LastRow qui est donc déclarée as
Integer… Pour 65536, il faudrait déclarer
As Long… Ce n’est pas catastrophique si on ne va jamais au-delà du remplissage de la Ligne 32767… Sinon Oui !!!!
Select / Selection à Eviter
C’est primordial sous Excel de ne pas faire de Sélection, de Feuille ou de Range, ou de Cellule tant que l’on peut l’éviter.
Et contrairement à ce que Pat a l’air de penser en disant ' donc de gagner un peu de temps... ? ' c’est vraiment beaucoup de Temps…
Vous ne me croyez pas... Démo !!!
Sub TestSelect()
Dim Cell As Range, Plage As Range
Dim Timing As Double
Timing = Timer
Set Plage = Range('A1:A5000')
For Each Cell In Plage
Cell.Select
If Selection = '' Then Selection.Interior.Color = vbBlack
Next Cell
MsgBox 'Durée ' & Timer - Timing
End Sub
Sub TestSansSelect()
Dim Cell As Range, Plage As Range
Dim Timing As Double
Timing = Timer
Set Plage = Range('A1:A5000')
For Each Cell In Plage
If Cell = '' Then Cell.Interior.Color = vbBlack
Next Cell
MsgBox 'Durée ' & Timer - Timing
End Sub
Faites tourner les deux sur un classeur Vierge et comparer, sur la machine où je suis dans les
9 secondes pour la première macro, dans les
2 secondes pour la seconde....
Y a pas Photo !!
Par contre Bertrand,
rien, mais rien à voir avec Select Case !!!!
Bon il a tellement de questions que je ne sais plus en j'en suis et je dois bosser un peu aussi !!! lol
Pour USF-Reblochon-Beta-Version-V01-01.zip et la référence manquante...
C’est sûrement le
Microsoft Calendar Control 10.0… Tu as quelle Version d’Excel Pat ?, sinon c’est vraiment un mini Plus qui n’est pas important ce Calendar, tu peux supprimer pûrement et simplement le UserForm3… Et dans le Code du UserForm2 tu supprimes ceci :
Private Sub LblDate_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
UserForm3.Show
End Sub
Copier en plus des lignes, la case juste au dessus, cad la 'semaine X' ?
Je t'avoue ne pas saisis ce que tu dis par là Guigui ? Semaine X vient d'où ? Et tu le veux Où ? Au dessus de chaque ligne retournée avec une occurrence trouvée sur 'Toto'... car pour moi ce n'est pas du clair ce que tu souhaites faire...
Comment integrer le choix des noms, je l'ai pour Toto mais pour les autres ?
En fait Bertrand répond très bien pour récupérer ton nom dans une Cellule, et si tu veux une InputBox alors voici comment je ferai :
Option Explicit
Option Compare Text
Sub Copier_les_cellules_vers_F4_Corrected() ' des 3 1eres feuilles vers la 4eme
Dim Plage As Range, Cell As Range, Lastrow As Integer, I As Byte
Dim SearchedString As String
SearchedString = InputBox('Veuillez Indiquer le Mot recherché', 'Recherche', 'Toto')
If SearchedString = '' Then Exit Sub
For I = 1 To 3
With Sheets(I)
Lastrow = .Range('A32767').End(xlUp).Row
For Each Cell In .Range('A2:A' & Lastrow)
If Cell.Value = SearchedString Then
Set Plage = Union(Cell, Cell.EntireRow)
Plage.Copy Destination:=Sheets(4).Range('a65536').End(xlUp)(2)
End If
Next
End With
Next I
End Sub
Voilà en espérant ne pas avoir Zappé des points, sinon vous me le direz !!!!
Bonne Journée
@+Thierry