Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

code vba pour ouvrir feuil et extraire données

12 réponses
Avatar
PLG
Bonjour

Allons y...!
J'ai 10 feuilles nommées : 1,2,3.....10
Ces 10 feuilles correspondent à 10 acivités sportives ( football, rugby,
tennis.....)
Sur ces 10 feuilles, en col A, j'ai des dates du 1er Janv au 31 déc.
En col B le n° du mois ( de 1 à 12 donc ) d'après la date.

Sur la feuille nommée 11, en col A, B, C et D, je souhaiterais récupérer les
données situées en col C à E et en col G d' une des feuilles 1 à 10.
Le choix en feuille 11 est double, 2 critères donc.
1er choix proposé : les 10 activités : Football ( feuil 1); rugby ( feuil 2)
.....
2ème choix proposé : le mois.

Donc, si je choisi : Rugby et le mois de février il faut se positionner sur
la feuille 2
et extraire les données situées en regard du mois 2, des col C,D,E et G et
les coller en feuil 11 en A,B,C et D

J'espère avoir été assez clair ( oui... pas vrai !! )
En attendant, je pense, un petit code VBA, because avec les fonctions je
vois pas à cause du choix de la feuille, le reste avec index(equiv()) ça le
faisait.

Merci de votre sollicitude.
A bientôt vous lire

2 réponses

1 2
Avatar
Daniel.C
Sub test2()
Dim Année, Sports, Mois As Integer, NumSport As String, plage As
Range
Année = Array("Janvier", "Février", "Mars") ' à compléter
Sports = Array("Football", "Rugby", "Tennis") ' à compléter
Mois = Application.Match([11!G1], Année, 0)
NumSport = CStr(Application.Match([11!F1], Sports, 0))
With Sheets(NumSport)
.AutoFilterMode = none
Range(.[A2], .[G65000].End(xlUp)).AutoFilter , field:=2,
Criteria1:=Mois
Set plage = .[_filterdatabase].Offset(1, 2)
Set plage = plage.Resize(plage.Rows.Count -
1).SpecialCells(xlCellTypeVisible)
Set plage1 = plage.Resize(, 3)
plage1.Copy [11!A2]
Set plage1 = plage.Offset(, 4).Resize(, 1)
plage1.Copy [11!D2]
.AutoFilterMode = none
End With
End Sub

Daniel

STOP, elle fonctionne, c'est moi qui me suis gouré avec le mois...!!!
Par contre ma demande pour les filtres est toujours d'actualité.... peux tu
les virer ?

"PLG" a écrit :

Help..... SOS.... !!!
Nan, tout compte fait, ta macro marche tant que c'est le mois de janvier !!!
Si je choisi un autre mois, elle me renvoie toujours Janvier.
En fait elle doit renvoyer le mois choisi au début...!
Je pense que c'est à cause des filtres qui restent en place...!

"Daniel.C" a écrit :

Bonjour.
Voici le code modifié :

Sub test2()
Dim Année, Sports, Mois As Integer, NumSport As String, plage As
Range
Année = Array("Janvier", "Février", "Mars") ' à compléter
Sports = Array("Football", "Rugby", "Tennis") ' à compléter
Mois = Application.Match([11!G1], Année, 0)
NumSport = CStr(Application.Match([11!F1], Sports, 0))
With Sheets(NumSport)
.AutoFilterMode = none
Range(.[A1], .[G65000].End(xlUp)).AutoFilter , field:=2,
Criteria1:=Mois
Set plage = .[_filterdatabase].Offset(1, 2)
Set plage = plage.Resize(plage.Rows.Count -
1).SpecialCells(xlCellTypeVisible)
Set plage1 = plage.Resize(, 3)
plage1.Copy [11!A2]
Set plage1 = plage.Offset(, 4).Resize(, 1)
plage1.Copy [11!D2]
End With
End Sub

Daniel

Bonjour Daniel

J'ai vu tes messages ainsi que ton fichier joint.
Pas tout à fait ce que je souhaite et comme je suis un gros fainéant (
non... c'est pas vrai ) peux tu s'il te plait adapter ta macro au fichier
joint.
Tout y est expliqué.
Si tu peux.... c'est très gentil.
Merci d'avance
Patrick

http://cjoint.com/?cpnoA10t4g



"Daniel.C" a écrit :

Ou plutôt :

Sub test()
Dim Année, Sports, Mois As Integer, NumSport As String, plage As
Range
Année = Array("Janvier", "Février", "Mars") ' à compléter
Sports = Array("Football", "Rugby", "Tennis") ' à compléter
Mois = Application.Match([11!G1], Année, 0)
NumSport = CStr(Application.Match([11!F1], Sports, 0) * 10)
With Sheets(NumSport)
.AutoFilterMode = none
Range(.[A1], .[G65000].End(xlUp)).AutoFilter , field:=2,
Criteria1:=Mois
Set plage = .[_filterdatabase].Offset(1, 2)
Set plage = plage.Resize(plage.Rows.Count -
1).SpecialCells(xlCellTypeVisible)
Set plage1 = plage.Resize(, 3)
plage1.Copy [11!A1]
Set plage1 = plage.Offset(, 4).Resize(, 1)
plage1.Copy [11!D1]
End With
End Sub

Daniel

Oups, effectivement. Modifie comme suit :

Sub test()
Dim Année, Sports, Mois As Integer, NumSport As String, plage As
Range Année = Array("Janvier", "Février", "Mars") ' à compléter
Sports = Array("Football", "Rugby", "Tennis") ' à compléter
Mois = Application.Match([11!G1], Année, 0)
NumSport = CStr(Application.Match([11!F1], Sports, 0) * 10)
With Sheets(NumSport)
.AutoFilterMode = none
Range(.[A1], .[G65000].End(xlUp)).AutoFilter , field:=2,
Criteria1:=Mois
Set plage = .[_filterdatabase].Offset(1, 2)
Set plage = plage.Resize(plage.Rows.Count - 1)
Set plage1 = plage.Resize(, 3)
plage1.Copy [11!A1]
Set plage1 = plage.Offset(, 4).Resize(, 1)
plage1.Copy [11!D1]
End With
End Sub

Daniel

Bonsoir Daniel

J'ai testé ton code, mais ça plante...!
Je verrai cela demain, car il faut, excuse moi, que j'aille me mettre
sous les draps...!
Mon réveil ne me fait pas de cadeau.... l'ignoble !
Toujours est il, je te remercie de t'être occupé de moi !
Bonne soirée et nuit

"Daniel.C" a écrit :

Bonjour.
Essaie la macro suivante. Le sport à sélectionner est sur la feuille
11, en F1 et le mois en G1.

Sub test()
Dim Année, Sports, Mois As Integer, NumSport As String, plage As
Range Année = Array("Janvier", "Février", "Mars") ' à compléter
Sports = Array("Football", "Rugby", "Tennis") ' à compléter
Mois = Application.Match([11!G1], Année, 0)
NumSport = CStr(Application.Match([11!F1], Sports, 0) * 10)
With Sheets(NumSport)
.AutoFilterMode = none
Range(.[A1], .[G65000].End(xlUp)).AutoFilter , field:=2,
Criteria1:=Mois
Set plage = [_filterdatabase].Offset(1, 2)
Set plage = plage.Resize(plage.Rows.Count - 1)
plage.Select
Set plage1 = plage.Resize(, 3)
plage1.Copy [11!A1]
Set plage1 = plage.Offset(, 4).Resize(, 1)
plage1.Copy [11!D1]
End With
End Sub


Tu trouveras un classeur à l'adresse suivante :
http://www.cijoint.fr/cjlink.php?file=cj200902/cijgFsJdCT.xls
Cordialement.
Daniel

Bonjour

Allons y...!
J'ai 10 feuilles nommées : 1,2,3.....10
Ces 10 feuilles correspondent à 10 acivités sportives ( football,
rugby, tennis.....)
Sur ces 10 feuilles, en col A, j'ai des dates du 1er Janv au 31 déc.
En col B le n° du mois ( de 1 à 12 donc ) d'après la date.

Sur la feuille nommée 11, en col A, B, C et D, je souhaiterais
récupérer les données situées en col C à E et en col G d' une des
feuilles 1 à 10. Le choix en feuille 11 est double, 2 critères donc.
1er choix proposé : les 10 activités : Football ( feuil 1); rugby (
feuil 2) .....
2ème choix proposé : le mois.

Donc, si je choisi : Rugby et le mois de février il faut se
positionner sur la feuille 2
et extraire les données situées en regard du mois 2, des col C,D,E et
G et les coller en feuil 11 en A,B,C et D

J'espère avoir été assez clair ( oui... pas vrai !! )
En attendant, je pense, un petit code VBA, because avec les fonctions
je vois pas à cause du choix de la feuille, le reste avec
index(equiv()) ça le faisait.

Merci de votre sollicitude.
A bientôt vous lire


























Avatar
PLG
Daniel,
je te remercie pour m'avoir dépanné et pour avoir été si patient... avec moi.

Bonne et longue vie à toi sur le forum
A une prochaine... peut-être
Bonne soirée

"Daniel.C" a écrit :

Sub test2()
Dim Année, Sports, Mois As Integer, NumSport As String, plage As
Range
Année = Array("Janvier", "Février", "Mars") ' à compléter
Sports = Array("Football", "Rugby", "Tennis") ' à compléter
Mois = Application.Match([11!G1], Année, 0)
NumSport = CStr(Application.Match([11!F1], Sports, 0))
With Sheets(NumSport)
.AutoFilterMode = none
Range(.[A2], .[G65000].End(xlUp)).AutoFilter , field:=2,
Criteria1:=Mois
Set plage = .[_filterdatabase].Offset(1, 2)
Set plage = plage.Resize(plage.Rows.Count -
1).SpecialCells(xlCellTypeVisible)
Set plage1 = plage.Resize(, 3)
plage1.Copy [11!A2]
Set plage1 = plage.Offset(, 4).Resize(, 1)
plage1.Copy [11!D2]
.AutoFilterMode = none
End With
End Sub

Daniel

> STOP, elle fonctionne, c'est moi qui me suis gouré avec le mois...!!!
> Par contre ma demande pour les filtres est toujours d'actualité.... peux tu
> les virer ?
>
> "PLG" a écrit :
>
>> Help..... SOS.... !!!
>> Nan, tout compte fait, ta macro marche tant que c'est le mois de janvier !!!
>> Si je choisi un autre mois, elle me renvoie toujours Janvier.
>> En fait elle doit renvoyer le mois choisi au début...!
>> Je pense que c'est à cause des filtres qui restent en place...!
>>
>> "Daniel.C" a écrit :
>>
>>> Bonjour.
>>> Voici le code modifié :
>>>
>>> Sub test2()
>>> Dim Année, Sports, Mois As Integer, NumSport As String, plage As
>>> Range
>>> Année = Array("Janvier", "Février", "Mars") ' à compléter
>>> Sports = Array("Football", "Rugby", "Tennis") ' à compléter
>>> Mois = Application.Match([11!G1], Année, 0)
>>> NumSport = CStr(Application.Match([11!F1], Sports, 0))
>>> With Sheets(NumSport)
>>> .AutoFilterMode = none
>>> Range(.[A1], .[G65000].End(xlUp)).AutoFilter , field:=2,
>>> Criteria1:=Mois
>>> Set plage = .[_filterdatabase].Offset(1, 2)
>>> Set plage = plage.Resize(plage.Rows.Count -
>>> 1).SpecialCells(xlCellTypeVisible)
>>> Set plage1 = plage.Resize(, 3)
>>> plage1.Copy [11!A2]
>>> Set plage1 = plage.Offset(, 4).Resize(, 1)
>>> plage1.Copy [11!D2]
>>> End With
>>> End Sub
>>>
>>> Daniel
>>>
>>>> Bonjour Daniel
>>>>
>>>> J'ai vu tes messages ainsi que ton fichier joint.
>>>> Pas tout à fait ce que je souhaite et comme je suis un gros fainéant (
>>>> non... c'est pas vrai ) peux tu s'il te plait adapter ta macro au fichier
>>>> joint.
>>>> Tout y est expliqué.
>>>> Si tu peux.... c'est très gentil.
>>>> Merci d'avance
>>>> Patrick
>>>>
>>>> http://cjoint.com/?cpnoA10t4g
>>>>
>>>>
>>>>
>>>> "Daniel.C" a écrit :
>>>>
>>>>> Ou plutôt :
>>>>>
>>>>> Sub test()
>>>>> Dim Année, Sports, Mois As Integer, NumSport As String, plage As
>>>>> Range
>>>>> Année = Array("Janvier", "Février", "Mars") ' à compléter
>>>>> Sports = Array("Football", "Rugby", "Tennis") ' à compléter
>>>>> Mois = Application.Match([11!G1], Année, 0)
>>>>> NumSport = CStr(Application.Match([11!F1], Sports, 0) * 10)
>>>>> With Sheets(NumSport)
>>>>> .AutoFilterMode = none
>>>>> Range(.[A1], .[G65000].End(xlUp)).AutoFilter , field:=2,
>>>>> Criteria1:=Mois
>>>>> Set plage = .[_filterdatabase].Offset(1, 2)
>>>>> Set plage = plage.Resize(plage.Rows.Count -
>>>>> 1).SpecialCells(xlCellTypeVisible)
>>>>> Set plage1 = plage.Resize(, 3)
>>>>> plage1.Copy [11!A1]
>>>>> Set plage1 = plage.Offset(, 4).Resize(, 1)
>>>>> plage1.Copy [11!D1]
>>>>> End With
>>>>> End Sub
>>>>>
>>>>> Daniel
>>>>>
>>>>>> Oups, effectivement. Modifie comme suit :
>>>>>>
>>>>>> Sub test()
>>>>>> Dim Année, Sports, Mois As Integer, NumSport As String, plage As
>>>>>> Range Année = Array("Janvier", "Février", "Mars") ' à compléter
>>>>>> Sports = Array("Football", "Rugby", "Tennis") ' à compléter
>>>>>> Mois = Application.Match([11!G1], Année, 0)
>>>>>> NumSport = CStr(Application.Match([11!F1], Sports, 0) * 10)
>>>>>> With Sheets(NumSport)
>>>>>> .AutoFilterMode = none
>>>>>> Range(.[A1], .[G65000].End(xlUp)).AutoFilter , field:=2,
>>>>>> Criteria1:=Mois
>>>>>> Set plage = .[_filterdatabase].Offset(1, 2)
>>>>>> Set plage = plage.Resize(plage.Rows.Count - 1)
>>>>>> Set plage1 = plage.Resize(, 3)
>>>>>> plage1.Copy [11!A1]
>>>>>> Set plage1 = plage.Offset(, 4).Resize(, 1)
>>>>>> plage1.Copy [11!D1]
>>>>>> End With
>>>>>> End Sub
>>>>>>
>>>>>> Daniel
>>>>>>
>>>>>>> Bonsoir Daniel
>>>>>>>
>>>>>>> J'ai testé ton code, mais ça plante...!
>>>>>>> Je verrai cela demain, car il faut, excuse moi, que j'aille me mettre
>>>>>>> sous les draps...!
>>>>>>> Mon réveil ne me fait pas de cadeau.... l'ignoble !
>>>>>>> Toujours est il, je te remercie de t'être occupé de moi !
>>>>>>> Bonne soirée et nuit
>>>>>>>
>>>>>>> "Daniel.C" a écrit :
>>>>>>>
>>>>>>>> Bonjour.
>>>>>>>> Essaie la macro suivante. Le sport à sélectionner est sur la feuille
>>>>>>>> 11, en F1 et le mois en G1.
>>>>>>>>
>>>>>>>> Sub test()
>>>>>>>> Dim Année, Sports, Mois As Integer, NumSport As String, plage As
>>>>>>>> Range Année = Array("Janvier", "Février", "Mars") ' à compléter
>>>>>>>> Sports = Array("Football", "Rugby", "Tennis") ' à compléter
>>>>>>>> Mois = Application.Match([11!G1], Année, 0)
>>>>>>>> NumSport = CStr(Application.Match([11!F1], Sports, 0) * 10)
>>>>>>>> With Sheets(NumSport)
>>>>>>>> .AutoFilterMode = none
>>>>>>>> Range(.[A1], .[G65000].End(xlUp)).AutoFilter , field:=2,
>>>>>>>> Criteria1:=Mois
>>>>>>>> Set plage = [_filterdatabase].Offset(1, 2)
>>>>>>>> Set plage = plage.Resize(plage.Rows.Count - 1)
>>>>>>>> plage.Select
>>>>>>>> Set plage1 = plage.Resize(, 3)
>>>>>>>> plage1.Copy [11!A1]
>>>>>>>> Set plage1 = plage.Offset(, 4).Resize(, 1)
>>>>>>>> plage1.Copy [11!D1]
>>>>>>>> End With
>>>>>>>> End Sub
>>>>>>>>
>>>>>>>>
>>>>>>>> Tu trouveras un classeur à l'adresse suivante :
>>>>>>>> http://www.cijoint.fr/cjlink.php?file=cj200902/cijgFsJdCT.xls
>>>>>>>> Cordialement.
>>>>>>>> Daniel
>>>>>>>>
>>>>>>>>> Bonjour
>>>>>>>>>
>>>>>>>>> Allons y...!
>>>>>>>>> J'ai 10 feuilles nommées : 1,2,3.....10
>>>>>>>>> Ces 10 feuilles correspondent à 10 acivités sportives ( football,
>>>>>>>>> rugby, tennis.....)
>>>>>>>>> Sur ces 10 feuilles, en col A, j'ai des dates du 1er Janv au 31 déc.
>>>>>>>>> En col B le n° du mois ( de 1 à 12 donc ) d'après la date.
>>>>>>>>>
>>>>>>>>> Sur la feuille nommée 11, en col A, B, C et D, je souhaiterais
>>>>>>>>> récupérer les données situées en col C à E et en col G d' une des
>>>>>>>>> feuilles 1 à 10. Le choix en feuille 11 est double, 2 critères donc.
>>>>>>>>> 1er choix proposé : les 10 activités : Football ( feuil 1); rugby (
>>>>>>>>> feuil 2) .....
>>>>>>>>> 2ème choix proposé : le mois.
>>>>>>>>>
>>>>>>>>> Donc, si je choisi : Rugby et le mois de février il faut se
>>>>>>>>> positionner sur la feuille 2
>>>>>>>>> et extraire les données situées en regard du mois 2, des col C,D,E et
>>>>>>>>> G et les coller en feuil 11 en A,B,C et D
>>>>>>>>>
>>>>>>>>> J'espère avoir été assez clair ( oui... pas vrai !! )
>>>>>>>>> En attendant, je pense, un petit code VBA, because avec les fonctions
>>>>>>>>> je vois pas à cause du choix de la feuille, le reste avec
>>>>>>>>> index(equiv()) ça le faisait.
>>>>>>>>>
>>>>>>>>> Merci de votre sollicitude.
>>>>>>>>> A bientôt vous lire
>>>>>>>>
>>>>>>>>
>>>>>
>>>>>
>>>>>
>>>
>>>
>>>





1 2