VBA isoler dates de toute une ligne a partir de cellules

Version imprimable

Bonjour :)

Dans mon fichier il y a dans une colonne A des dates et dans une colonne B les information correspondantes

Alors je vous explique mon problème, j'ai une macro qui selon l'année de la date que je saisi me retrouve dans ma colonne A (de ma feuille 1) toutes les dates concerner par cette année et me colorie les cellules en rouge
en plus de sa elle prend les dates concerner et me les met a part dans une feuille 2
le problème c'est quelle ne prend et n'isole que la colonne A et non la colonne B qui correspond aux informations

merci de votre aide !
voici le code de la macro
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Sub date_4() Dim X As Variant Dim Cel As Range X = Application.InputBox("Année de la date", "ANNÉE", Type:=1) If X = False Then Exit Sub Worksheets("feuil2").Cells.ClearContents 'efface cellules feuille Set Cel = Sheets("Feuil1").UsedRange.Find(X, lookat:=xlPart) If Not Cel Is Nothing Then PA = Cel.Address lig = 1 'ligne de depart pour feuil2 Do Cel.Interior.ColorIndex = 3 Worksheets("feuil2").Cells(lig, 1) = Cel.Value 'ecriture lig = lig + 1 '+1 pour donnee suivante Set Cel = Sheets("Feuil1").UsedRange.FindNext(Cel) Loop While Not Cel Is Nothing And Cel.Address <> PA End If End Sub

27/04/2017, 10h11
unparia

Bonjour
Où est la difficulté ?
Si tu as "cerné" une cellule Cel de la colonne A, la cellule en regard dans la colonne B est Cel.Offset(0,1)
yapluka, non ?

Le caractère "sibyllin" de ma réponse est en adéquation avec le titre ( "VBA MACRO ==> SUITE D'UNE MACRO") que tu as donné à cette discussion. Il ne résume en rien la difficulté rencontrée.:roll:
27/04/2017, 11h08
eliana55

je n'ai pas tout compris , mais si je fais sa
ajouter une seconde ligne de code pour lui dire de prendre également la cellule d' à côté...
par exemple :

Worksheets("feuil2").Cells(lig, 2) =Sheets("Feuil1").cells(Cel.Row,2).Value

mais le problème c'est que si on rajoute 10 colonnes et que je veux qu'il me les prennent tous , je devrais rajouter une ligne dans mon code a chaque fois

il serait plus judicieux de prendre toute la ligne concerner par la date nan ?
comment puis-je faire sa ?

ps: desole pour le titre non explicite :'(
27/04/2017, 11h14
unparia

Citation:

comment puis-je faire sa

Fais l'effort de modifier ton titre et je serai alors moins "avare" de détails. ;)
Je ne veux pas l'être dans une discussion où la solution serait perdue (sauf pour toi) du seul fait d'un tel titre.
27/04/2017, 11h15
Menhir

Juste après ton Do, mets :

Code:

Set Cel = Cel.Range("A1:B1")

Bonjour
J'ai pas vérifier mais peut etre c'est ça :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Sub date_4()
    Dim X As Variant
    Dim Cel As Range
 
    X = Application.InputBox("Année de la date", "ANNÉE", Type:=1)
    If X = False Then Exit Sub
    Worksheets("feuil2").Cells.ClearContents    'efface cellules feuille
    Set Cel = Sheets("Feuil1").UsedRange.Find(X, lookat:=xlPart)
    If Not Cel Is Nothing Then
        PA = Cel.Address
        lig = 1     'ligne de depart pour feuil2
        Do
                    Cel.Interior.ColorIndex = 3
            Worksheets("feuil2").Cells(lig, 1) = Cel.Value    'ecriture
            Worksheets("feuil2").Cells(lig, 2) = Cells(cel.row,2).Value 
            lig = lig + 1       '+1 pour donnee suivante
            Set Cel = Sheets("Feuil1").UsedRange.FindNext(Cel)
        Loop While Not Cel Is Nothing And Cel.Address <> PA
    End If
End Sub

27/04/2017, 11h19
halaster08

Citation:

il serait plus judicieux de prendre toute la ligne concerner par la date nan ?
comment puis-je faire sa ?

L'enregistreur de macro te donnera la réponse: Tuto

Et j'insiste le filtre avancé (qu'on peut faire par macro) serait mille fois plus simple et rapide.
27/04/2017, 14h24
eliana55

Unparia j'ai modifié l'intitulé de ma demande ;) pourrai-tu m'expliquer stp comment prendre en compte toutes la ligne et non rajouter les colonnes dans mon code a chaque fois

halaster08 je vais essayer mais je n'ai jamais essayer avec un filtre avancé

BENNASR cela m'isole bien la colonne B correspondante mais si je créer une colonne c il faut aussi la rajouter dans mon code cela ne m'arrange pas il faudrait que sa prennent en compte toute la ligne de la date concerne

Menhir cela Set Cel = Cel.Range("A1:B1")ne prend en compte que les colonnes et non la ligne entiere

Je pense que je pourrais indiquer Set Cel = Cel.Range("A1:Y1")mais je sais pas si c'est la solution la plus appropriés

merci de vos réponses :)
27/04/2017, 14h40
Menhir

Citation:

Envoyé par eliana55

Menhir cela Set Cel = Cel.Range("A1:B1")ne prend en compte que les colonnes et non la ligne entiere

Dans ce cas, pose ta question plus clairement.
Parce que dans ta question, tu ne parles que de deux colonnes : A et B. :roll:

Citation:

le problème c'est quelle ne prend et n'isole que la colonne A et non la colonne B qui correspond aux informations

Citation:

Je pense que je pourrais indiquer Set Cel = Cel.Range("A1:Y1")mais je sais pas si c'est la solution la plus appropriés

Si tu avais pris le peine de tester, tu le saurais.
27/04/2017, 14h49
eliana55

Citation:

Dans ce cas, pose ta question plus clairement.
Parce que dans ta question, tu ne parles que de deux colonnes : A et B.

==> oui c'est vrai j'aurai du etre plus clair , j'en ai parler plus tard

Citation:

Si tu avais pris le peine de tester, tu le saurais.

==> je les tester sa me colorie toutes la ligne mais sa n'isole pas les valeur il s'arrête a la colonne B
27/04/2017, 15h32
Menhir

Citation:

Envoyé par eliana55

mais le problème c'est que si on rajoute 10 colonnes et que je veux qu'il me les prennent tous , je devrais rajouter une ligne dans mon code a chaque fois

il serait plus judicieux de prendre toute la ligne concerner par la date nan ?
comment puis-je faire sa ?

Non, ce qui serait plus judicieux, ce serait de rechercher combien de colonnes sont utilisées.

Si tu veux prendre toute la ligne, change ma commande par :

Code:

Set Cel = Cel.EntireRow

Mais, je le répète, c'est une mauvaise idée.

Edit : Autre modif.
Je n'avais pas vu que tu transférais tes données par valeur au lieu de faire une copie.
Donc il faudrait remplacer :

Code:

Worksheets("feuil2").Cells(lig, 1) = Cel.Value 'ecriture

par

Code:

Cel.Copy Worksheets("feuil2").Cells(lig, 1) 'ecriture

en le plaçant avant ta modification de couleur.

bonsoir :
Colonne par colonne voir ma réponse si haut : Aujourd'hui, 10h18
Copier ligne entière comme a recommandé Menhir : Cel.EntireRow
ce qui donne :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub date_4()
    Dim X As Variant
    Dim Cel As Range
    Application.ScreenUpdating = False
    X = Application.InputBox("Année de la date", "ANNÉE", Type:=1)
    If X = False Then Exit Sub
    Worksheets("feuil2").Cells.ClearContents    'efface cellules feuille
    Set Cel = Sheets("Feuil1").UsedRange.Find(X, lookat:=xlPart)
    If Not Cel Is Nothing Then
        PA = Cel.Address
        Lig = 1     'ligne de depart pour feuil2
        Do
            Cel.Interior.ColorIndex = 3
            Sheets("Feuil2").Activate
            Cel.EntireRow.Copy
            Lig = Lig + 1       '+1 pour donnee suivante
            Cells(Lig, 1).Select
            ActiveSheet.Paste
            Set Cel = Sheets("Feuil1").UsedRange.FindNext(Cel)
        Loop While Not Cel Is Nothing And Cel.Address <> PA
    End If
    Application.ScreenUpdating = True
End Sub

Bonne continuation

27/04/2017, 16h15
eliana55

genial c parfait :D merciii bcp :D :oops:

Proposition avec filtre avancé, donc sans boucle, bien plus simple et rapide a mon avis.

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub Macro1()
 
Sheets("Sheet2").Cells.ClearContents 'efface le contenu de la sheet2 pour y mettre le résultat
    Sheets("Sheet2").Range("A1") = "date" 'nom de la colonne contenant la date
    Sheets("Sheet2").Range("A2") = "2016" 'date pour l'exemple peut être remplacée par le résultat de ton inputbox
'filtre avancé
    Sheets("Sheet1").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Sheets("Sheet2").Range("A1:A2"), CopyToRange:=Sheets("Sheet2").Range("A4"), Unique:=False
    Sheets("Sheet2").Rows("1:3").Delete Shift:=xlUp
 
End Sub