Suite d'une macro

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

3 réponses

  1. Modérateur
    Bonjour,


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


    Tu veux donc parler de cette ligne de code ... qui ne prend QUE la valeur de la cellule "trouvée" par ton find.
     Worksheets("feuil2").Cells(lig, 1) = Cel.Value 
    


    Il suffirait d'ajouter une seconde ligne de code pour lui dire de prendre également la cellule d' à côté...
    Plusieurs façons de faire ... par exemple :
     
     Worksheets("feuil2").Cells(lig, 2) =Sheets("Feuil1").cells(Cel.Row,2).Value 
    


    Cordialement, 
    Jordane                                                                 
    0
    1. Bonjour Jordane45,

      Eh oui! Elio45 voir votre demande:

      ISOLER DES CELLULES GRISES
      elio55 - 26 avril 2017 à 10:46 - Dernière réponse le 26 avril 2017 à 13:11 par elio55

      je souhaiterais isoler dans une autre feuille toutes les cellules en rouge
      0
    2. jordane45 saurais tu comment faire si je veux inclure la colonne c par exemple stp juste pour pouvoir avoir un exemple parce que juste avec la b ce n'est pas évident
      mercii :)
      0
    3. @elio55Bonjour,

      deux facons de faire, suivant "ma" programmation:
       With Worksheets("feuil2")
                      .Cells(lig, 1) = Cel.Value      'ecriture colonne A
                      .Cells(lig, 2) = Cel.Offset(0, 1).Value      'ecriture colonne B
                      .Cells(lig, 3) = Cel.Offset(0, 2).Value      'ecriture colonne C
                  End With

      'ou suivant programmation jordane45
                  Worksheets("feuil2").Cells(lig, 1) = Sheets("Feuil1").Cells(Cel.Row, 1).Value
                  Worksheets("feuil2").Cells(lig, 2) = Sheets("Feuil1").Cells(Cel.Row, 2).Value
                  Worksheets("feuil2").Cells(lig, 3) = Sheets("Feuil1").Cells(Cel.Row, 3).Value
      
      0
    4. @f894009c'est parfait mercii bcpp :D f894009
      0
    5. Modérateur
      Ou encore .... si tu as plusieurs colonnes à copier (par exemple 10 ... )
       With Worksheets("feuil2")
           for c = 1 to  10
               .Cells(lig, 2 + c).value  = Cel.Offset(0, c) .value     'ecriture colonne numero "c" (1 puis 2 puis 3 .. 10 )
            Next
       End With
      
      0
  2. merci pour votre réponse ! oui c'est ce principe
    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 ?
    -1
    1. Re,

      c'est que si on rajoute 10 colonnes
      sur le meme code:
      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(CDate(X), lookat:=xlPart)
          If Not Cel Is Nothing Then
              PA = Cel.Address
              lig = 1     'ligne de depart pour feuil2
              Do
                  With Worksheets("feuil2")
                      For c = 0 To 9     'changez le 9 (de 1 a 10) par le nombre de colonnes que vous voulez
                          .Cells(lig, 1 + c) = Cel.Offset(0, c)      'ecriture colonne numero "c" (1 puis 2 puis 3 .. 10 )
                      Next c
                      lig = lig + 1 '+1 pour donnee suivante
                  End With
                  Set Cel = Sheets("Feuil1").UsedRange.FindNext(Cel)
              Loop While Not Cel Is Nothing And Cel.Address <> PA
          End If
      End Sub


      Il y a d'autre facons, mais c'est a vous de voir ..........
      0