rechercher une date et copier la colonne dans un autre onglet [Résolu]

[jd69001]

Bonjour,

Je souhaitais utiliser le code fournis dans cette discussion en le modifiant mais une fois fait celui ci ne fonctionne plus.

Code modifier :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Oval3_Click()
 
NbLigne = Application.Subtotal(3, Sheets("janvier").Range("3:3"))
LaDate = Sheets("janvier").Range("ag1") 'il faut noter la date recherchée dans la feuille1 cellule d1
 
 
For i = 1 To NbLigne
 
    If Cells(i, 1).Value = LaDate Then
    Cells(i, 1).EntireColumn.Copy
    Sheets("quiestla").Range("a1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Copie en valeur dans A1 de la feuille2
    Exit Sub 'Sort de la boucle !seulement si une seule date possible
    End If
 
Next i
 
End Sub

Par rapport au post initial dans mon cas je souhaiterais copier "la colonne"
sous cette date et non la ligne, mes dates son toutes dans la "ligne 3"
et ma cellule de reference date est "Ag1"
la feuille de ref est "janvier", la feuille cible est "quiestla"

Pouriez vous m'aider ?

Cordialement

[BlueMonkey]

Bonjour,

Le code précédent parcours les lignes à la recherche de la date :
[code]Cells(<n° de ligne>, <n° de colonne>)

En corrigeant pour chercher dans les colonnes de la ligne 3

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Dim NbColonne As Integer
Dim Ladate As Date
NbColonne = Application.Subtotal(3, Sheets("janvier").Range("3:3"))
Ladate = Sheets("janvier").Range("ag1")
 
Dim i As Integer
For i = 1 To NbColonne
 
    If Cells(3, i).Value = Ladate Then
    Cells(3, i).EntireColumn.Copy
    Sheets("quiestla").Range("a1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'Copie en valeur dans A1 de la feuille2
    Exit Sub 'Sort de la boucle !seulement si une seule date possible
    End If
 
Next i

A noter qu'en utilisant un Range, plutôt qu"un compteur, le code est un peut plus clair, et ne nécessite pas de changement sur la boucle.

Code :

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
Dim DateRecherche As Date
Dim PlageDate As Range
Dim c As Range
 
With Worksheets("janvier")
    DateRecherche = .Range("ag1")
    'cherche dans la ligne
    Set PlageDate = Range(.Range("a3").Address & ":" & .Range("a3").End(xlToRight).Address)
    'cherche dans la colonne
    'Set PlageDate = Range(.Range("a3").Address & ":" & .Range("a3").End(xlDown).Address)
End With
 
For Each c In PlageDate
     If c.Value = DateRecherche Then
        c.EntireColumn.Copy
        'c.EntireRow.Copy
 
        Sheets("quiestla").Range("a1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                        :=False, Transpose:=False
 
        Application.CutCopyMode = False
 
        Exit For 'Sort de la boucle !seulement si une seule date possible
    End If
Next c

[jd69001]

Merci pour cette reponse je testerai mardi une fois de retour de week end

EDIT: MERCI mille fois cela fonctionne impecable