Sélectionner au-dessus

[Dom]

Bonjour tout le monde,
Vu votre grande efficacité je reviens avec un probleme.
La colonne A de mon fichier contient des noms et de temps un nombre. J'essaie de faire une macro qui me cherche le 1er nombre, selectionne la ligne et toutes celles au-dessus pour les copier dans une autre feuille.
Ce que j'ai fait me crée une feuille par cellule ? Mon fichier fait plus de 6000 lignes j'ai forcément un souci )
D'avance merci de votre aide mais comme je pars en vacances ce soir il n'y a aucune urgence. Bonne fêtes à tous

Sub Rapport()
Dim cr As Integer
cr = 1
For Each cell In Range("A1:A6000")
If ActiveCell.Value > cr Then
Range(ActiveCell, ActiveCell.Offset(0, 5)).Select
Range(ActiveCell, ActiveCell.End(xlUp)).Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Sheets("Sheet1").Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
End If
Next
End Sub

 

[Jacques]

je te propose de modifier ta macro comme suit :

Sub Rapport()
Dim cr As Integer
Range("A1").Select
For Each cell In Range("A1:A6000")
If ActiveCell.Value = "" Then Exit Sub
If IsNumeric(ActiveCell.Value) Then
Range(ActiveCell, ActiveCell.Offset(0, 5)).Select
Range(Selection, ActiveCell.End(xlUp)).Select
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Sheets("Feuil1").Select
Application.CutCopyMode = False
Selection.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Next
End Sub