Sub toto() Dim ShSource As Worksheet Dim ShCible As Worksheet Dim PlageATester As Range Dim LastRFsource As Long Dim LastRFcible As Long Set ShSource = ThisWorkbook.Sheets(1) Set ShCible = ThisWorkbook.Sheets(2) LastRFsource = Derniere_Ligne(ShSource) + 1 Set PlageATester = ShSource.Range(Cells(1, 2), Cells(LastRFsource, 2)) For Each cell In PlageATester Debug.Print cell.Value If cell.Value = 1 Then LastRFcible = Derniere_Ligne(ShCible) + 1 ShCible.Cells(LastRFcible, 1).Value = ShSource.Cells(cell.Row, 1).Value End If Next End Sub Function Derniere_Ligne(Sh As Worksheet) As Long On Error GoTo noRow Derniere_Ligne = Sh.Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row Exit Function noRow: Derniere_Ligne = 0 End Function
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionSi presence d'un "1" dans la case B1 à B
Modifié par ucfoutu le 29/12/2014 à 11:11
Il y a en effet (plusieurs) des solutions plus rapides en exécution.
Mais lis mon post scriptum (mon message précédent). Ce n'est pas au hasard que mon accueil de Ticrain a été plutôt "de saison"...
Je ne suis pas certain de ce que du code tout cuit lui rende un vrai service.
29 déc. 2014 à 11:29
Oui je sais bien... mais à force de trainer du côté de CCM ... je suis surement devenu trop gentil...
Et pour ce qui est de ton PS... je ne l'ai vu qu'après avoir posté ma réponse.
Modifié par ucfoutu le 29/12/2014 à 18:36
Bon.
La méthode la plus performante ? ===>>
Ses "1" (dont il se sert pour "cocher") sont donc manuels
La plage est donc déterminable par Specialcells(xlCellTypeConstants)
Et on peut deviner (s'il "coche", qu'en B, on a soit "1", soit rien (et rien d'autre)
Et donc :
Ce qui peut également s'écrire en une seule ligne de code, ainsi :
Amitiés.
PS : on peut d'ailleurs se demander pourquoi il "coche" à coups de "1" en B (plusieurs gestes à faire : clavier + souris) alors qu'il suffirait (souris + CTRL maintenu) de sélectionner dans A ! (puis d'utiliser l'objet selection, tout bêtement) !