VBA isoler dates de toute une ligne a partir de cellules

**eliana55** · 27/04/2017, 09h56

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 :

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
 
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

**unparia** · 27/04/2017, 10h11

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.

**eliana55** · 27/04/2017, 11h08

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 :'(

**unparia** · 27/04/2017, 11h14

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.

**BENNASR** · 27/04/2017, 11h18

Bonjour
J'ai pas vérifier mais peut etre c'est ç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
 
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

**halaster08** · 27/04/2017, 11h19

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.

**eliana55** · 27/04/2017, 14h24

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

**Menhir** · 27/04/2017, 14h40

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.

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

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.

**Menhir** · 27/04/2017, 15h32

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 :

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

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 :

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

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

par

Code :

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

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

en le plaçant avant ta modification de couleur.

**BENNASR** · 27/04/2017, 15h37

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 :

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
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