Discussion :

[moilou2]

Comment faire une boucle for next permettant de venir tester toutes les cellules d'une colonne?

[patbou]

bonjour,

un exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Sub colonne()
Dim cel As Range
For Each cel In Range("b:b")
If cel.Value = 12 Then MsgBox "ok"
Next
End Sub

[moilou2]

OK pour ton exemple sa marche!

Je voulais juste savoir, quand il affiche la msgBox il l'affiche quand il passe devant la cellule qui est égale à 12? et non à la fin de la macro?

Parce que moi l'idée, c'est que je test si les cellules de la colonne "H" sont égales à la date. J'utilise donc:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
Sub colonne()
Dim cel As Range
For Each cel In Range("h:h")
If cel.Value = Date Then MsgBox "ok"
Next
End Sub

Moi je ne voudrai pas que se soit une msgBox qui s'affiche, mais que sa copie les cellules des colonnes A, B, C, D, E, F, G, et H et que sa les colle dans un autre classeur.

C'est possible avec cette méthode du for each cellule in selection?

Merci à toi

[Qwazerty]

SAlut
Essais comme ca

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Sub colonne()
Dim cel As Range
For Each cel In Sheets("Feuil3").Range("h:h")
If cel.Value = Date Then
    'On copi les cellules dans une autre feuil
    'Je concidere que la ligne 1 de la feuil2 contient des entete de colonne (nom, date,prenom, .....)
    'ici je ne sais pas si A est toujours rempli
    With Sheets("Feuil2").Range("H1").End(xlDown).Offset(0, -7) 'si A toujours rempli mettre With Sheets("Feuil2").Range("A1").End(xlDown) à la place de cette ligne
        Sheets("Feuil3").Range(Cells(cel.Row, "A"), cel).Copy .Address
    End With
 
End If
Next
End Sub

A++
Qwaz

[moilou2]

Salut et merci pour ton aide mais j'ai une erreur avec ta méthode!

J'avais pensé à faire comme ça:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub colonne()
Dim cel As Range
For Each cel In Range("h:h")
 
If cel.Value = Date Then
ActiveCell.Select
ActiveCell.Offset(0, -1).Select
ActiveCell.Offset(0, -2).Select
ActiveCell.Offset(0, -3).Select
ActiveCell.Offset(0, -4).Select
ActiveCell.Offset(0, -5).Select
ActiveCell.Offset(0, -6).Select
ActiveCell.Offset(0, -7).Select
 
Selection.Copy
 
Set cellule = Sheets("Feuil1").Range("a1")
Do Until IsEmpty(cellule)
Set cellule = cellule.Offset(1, 0)
Loop
 
Sheets("Feuil1").Select
cellule.Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Next
 
End Sub

Mais j'ai un problème aussi

En fait l'élément qui me manque c'est comment une fois que j'ai détecté une cellule avec la date système lui dire de faire la celection de cette ligne de A à H

J'ai peut-être mal exprimé ce que je voulais faire dite moi si c'est le cas!

[Qwazerty]

Re

Cette fois c'est testé

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub colonne()
Dim cel As Range
For Each cel In Worksheets("Feuil3").Range(Worksheets("Feuil3").Range("H2"), Worksheets("Feuil3").Cells(Rows.Count, "H").End(xlUp))
If cel.Value = CDate("01/06/1980") Then
       Worksheets("Feuil3").Range("A" & cel.Row & ":H" & cel.Row).Copy Sheets("Feuil2").Cells(Rows.Count, "H").End(xlUp).Offset(1, -7)
End If
Next
End Sub

A++
Qwaz

[moilou2]

Re j'ai essayé se que tu ma fait! cette fois j'ai plus de message d'erreur, mais y se passe rien et j'ai un peu de mal a comprendre ton code!

Tu colles dans l'autre feuille nn?
parce que j'ai vu feuille 2 et feuille 3 donc je suppose que tu colles dans l'une des 2 mais j'ai vu que copy et j'ai pas vu paste.

Tu peut essayé de me commenter un peu ton code que j'essaye de le comprendre

Moi mes 2 feuilles s'appellent : -PMP (Feuille ou j'ai mes données)
-Feuille1( celle ou on colle les données)

Si tu regarde comment j'ai adapté sa correspond bien à ce que tu voulais faire?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Sub colonne1()
Dim cel As Range
For Each cel In Worksheets("PMP").Range(Worksheets("PMP").Range("H2"), Worksheets("PMP").Cells(Rows.Count, "H").End(xlUp))
If cel.Value = CDate("01/06/1980") Then
       Worksheets("PMP").Range("A" & cel.Row & ":H" & cel.Row).Copy Sheets("Feuil1").Cells(Rows.Count, "H").End(xlUp).Offset(1, -7)
End If
Next
End Sub

Merci

[Qwazerty]

Re
peut etre a cause de CDate("01/05/80") ? fallait remettre date, j'avais mis ca pour faire des testes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub colonne1()
Dim cel As Range
'Ici on boucle de la case H2 a la derniere case contenant des données (ca evite de boucler sur les 65000 ligne)
For Each cel In Worksheets("PMP").Range(Worksheets("PMP").Range("H2"), Worksheets("PMP").Cells(Rows.Count, "H").End(xlUp))
If cel.Value = Date Then 'ici fallait remettre date (j'avais lmis une autre date pour faire des essais
    'ici on selectionne de la case A à la case H cel.Row representant la ligne que l'on est en train de tester
    'F1 sur copy t'aurait indiquer ceci
    'Source.copy Destination
    'on copie donc de A à H et on envoie les données sur la derniere ligne pleine + 1 pour avoir la premiere vide et on pointe en meme temps sur la colonne A (H - 7 = A)
    Worksheets("PMP").Range("A" & cel.Row & ":H" & cel.Row).Copy Sheets("Feuil1").Cells(Rows.Count, "H").End(xlUp).Offset(1, -7)
End If
Next
End Sub

A++
Qwaz

[Abed_H]

Bonjour
voici un autre exemple à tester
tu colle ce code dans un module standard dans le classeur qui contient les données à tester classeur active ici c'est classeur 2

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Sub testeDate()
Dim cell As Range
Set TBt = ThisWorkbook.Worksheets("Feuil1").Range("A1:A500") 'classeur,feuille,plage qui contienne les données à tester
Set TWa = Workbooks("Classeur3").Worksheets("Feuil1") ' feuille qui recoit les données à adapter
    For Each cell In TBt
       If CDate(cell.Value) = Date Then
          TWa.Range("A65536").End(xlUp)(2).Resize(1, 10) = cell.Resize(1, 10).Value
      End If
    Next
  Set TBt = Nothing: Set TWa = Nothing
End Sub

Abed_H