Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel transfert données suivant 1 critère avec VBA

transfert données suivant 1 critère avec VBA

12 réponses
Avatar
tatanka
Bonjour,

J'ai un petit problème sur un de mes fichiers dont voici un exemple :
http://cjoint.com/?dDmDh1Uzxi

Dans ce fichier, je rentre des données manuellement et via un bouton cré
sous excel je fais un cumul de ces données.

Ce que j'aimerai, c'est qu'en utilisant ce même bouton, que mes données
aillent se sauvegarder dans un autre tableau.

Le critère de sauvegarde serait la semaine (S11,S12,etc dans le fichier joint)

Quelqu'un connaît il une macro que je pourrais utiliser pour mon fichier?

merci

cdt
Tatanka
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
Daniel.C
Bonjour.
Ou se trouve le tableau à remplir ? S'il commence en ligne 63, remplace
:
Cells(c.Row, Col2) = c.Offset(, 8)
par :
Cells(c.Row + 55, Col2) = c.Offset(, 8)
Daniel

Bon une dernière et après j'arrête^^

Donc pour un tableau pas de problème ca marche...

Par contre j'ai un deuxième tableau à renseigner via cette manip.

Voici ce que j'ai écrit (en dupliquant la méthode à Daniel):
Private Sub CommandButton2_Click()
Dim c As Range, Col As Integer
Application.ScreenUpdating = False
Col = Application.Match([M5], [A8:BH8], 0)
For Each c In Range([B9], [B65000].End(xlUp))
c.Offset(, 11) = c.Offset(, 11) + c.Offset(, 6)
Cells(c.Row, Col) = c.Offset(, 6)
c.Offset(, 6) = ""
Application.ScreenUpdating = True
Next c
Application.ScreenUpdating = False
Col2 = Application.Match([M5], [A62:BH62], 0)
For Each c In Range([B9], [B65000].End(xlUp))
c.Offset(, 13) = c.Offset(, 13) + c.Offset(, 8)
Cells(c.Row, Col2) = c.Offset(, 8)
c.Offset(, 8) = ""
Next c
Application.ScreenUpdating = True
End Sub

Sauf que la deuxième partie ne fonctionne pas, je n'ai pas de données qui
arrive dans mon deuxième tableau.

Si quelqu'un peut m'aider je suis prenneur



"tatanka" a écrit :

Merci Daniel

Ca fonctionne parfaitement

Et merci à FFO qui a passé beaucoup de temps sur mon pb

"Daniel.C" a écrit :

Bonjour.
Essaie :

Private Sub CommandButton2_Click()
Dim c As Range, Col As Integer
Application.ScreenUpdating = False
Col = Application.Match([M5], [A8:BH8], 0)
For Each c In Range([B9], [B65000].End(xlUp))
c.Offset(, 11) = c.Offset(, 11) + c.Offset(, 6)
c.Offset(, 6) = ""
Next c
For Each c In Range([B9], [B65000].End(xlUp))
c.Offset(, 13) = c.Offset(, 13) + c.Offset(, 8)
Cells(c.Row, Col) = c.Offset(, 8)
c.Offset(, 8) = ""
Next c
Application.ScreenUpdating = True
End Sub

Cordialement.
Daniel

Bon comme je galère de trop (et oui je suis une bille sur VBA...)
Je vous met ci joint un epartie de mon fichier :
http://www.cijoint.fr/cjlink.php?file=cj201003/cijIVB4x9n.xls

Alors les données sont renseignées dans les colonnes C et E.

Quand je viens cliquer sur "cumul semaine" les données sont additionnées
dans les colonnes H et J.

Et quand je viens cliquer sur cumul annuel, les données sont additionnées
en M et 0.

C'est à travers ce bouton "cumul annuel" que j'aimerai que le transfert se
fasse en tenant compte de la donnée en M5.

Le tableau historique commence à partir de la colonne T.

Si l'un d'entre vous arrive à me résourdre mon pb, ca serait vraiment
parfait!!!

ENcore merci à tout ceux qui prennnent du temps à aider les non expert en
VBA

"tatanka" a écrit :

Merci à vous trois pour vos réponses rapide

FFO, ca marche nikel sauf que (et oui sinon ce n'est pas drôle) ca ne me
reporte pas les données quand j'ai une cellule vide ou égal à 0

"FFO" a écrit :

Salut à toi

Ce code devrait faire :

Colonne = Range("G4", Cells(4,
Range("IV4").End(xlToLeft).Column).Address).Find(What:=Range("C4"),
After:=Range("G4"), LookIn:=xlValues, LookAt:=xlWhole).Column
i = 5
Do While Range("C" & i) <> ""
If Range("C" & i) <> 0 Then
Cells(65535, Colonne).End(xlUp).Offset(1, 0) = Range("C" & i)
End If
i = i + 1
Loop


sur ce lien ton fichier :

http://www.cijoint.fr/cjlink.php?file=cj201003/cijR7Pvot1.xls

Aprés l'avoir récupéré et ouvert cliques sur le bouton "Traitement"

Donnes moi des nouvelles !!!!!









.

Avatar
tatanka
réponse parfaite et rapide
merci

"Daniel.C" a écrit :

Bonjour.
Ou se trouve le tableau à remplir ? S'il commence en ligne 63, remplace
:
Cells(c.Row, Col2) = c.Offset(, 8)
par :
Cells(c.Row + 55, Col2) = c.Offset(, 8)
Daniel

> Bon une dernière et après j'arrête^^
>
> Donc pour un tableau pas de problème ca marche...
>
> Par contre j'ai un deuxième tableau à renseigner via cette manip.
>
> Voici ce que j'ai écrit (en dupliquant la méthode à Daniel):
> Private Sub CommandButton2_Click()
> Dim c As Range, Col As Integer
> Application.ScreenUpdating = False
> Col = Application.Match([M5], [A8:BH8], 0)
> For Each c In Range([B9], [B65000].End(xlUp))
> c.Offset(, 11) = c.Offset(, 11) + c.Offset(, 6)
> Cells(c.Row, Col) = c.Offset(, 6)
> c.Offset(, 6) = ""
> Application.ScreenUpdating = True
> Next c
> Application.ScreenUpdating = False
> Col2 = Application.Match([M5], [A62:BH62], 0)
> For Each c In Range([B9], [B65000].End(xlUp))
> c.Offset(, 13) = c.Offset(, 13) + c.Offset(, 8)
> Cells(c.Row, Col2) = c.Offset(, 8)
> c.Offset(, 8) = ""
> Next c
> Application.ScreenUpdating = True
> End Sub
>
> Sauf que la deuxième partie ne fonctionne pas, je n'ai pas de données qui
> arrive dans mon deuxième tableau.
>
> Si quelqu'un peut m'aider je suis prenneur
>
>
>
> "tatanka" a écrit :
>
>> Merci Daniel
>>
>> Ca fonctionne parfaitement
>>
>> Et merci à FFO qui a passé beaucoup de temps sur mon pb
>>
>> "Daniel.C" a écrit :
>>
>>> Bonjour.
>>> Essaie :
>>>
>>> Private Sub CommandButton2_Click()
>>> Dim c As Range, Col As Integer
>>> Application.ScreenUpdating = False
>>> Col = Application.Match([M5], [A8:BH8], 0)
>>> For Each c In Range([B9], [B65000].End(xlUp))
>>> c.Offset(, 11) = c.Offset(, 11) + c.Offset(, 6)
>>> c.Offset(, 6) = ""
>>> Next c
>>> For Each c In Range([B9], [B65000].End(xlUp))
>>> c.Offset(, 13) = c.Offset(, 13) + c.Offset(, 8)
>>> Cells(c.Row, Col) = c.Offset(, 8)
>>> c.Offset(, 8) = ""
>>> Next c
>>> Application.ScreenUpdating = True
>>> End Sub
>>>
>>> Cordialement.
>>> Daniel
>>>
>>>> Bon comme je galère de trop (et oui je suis une bille sur VBA...)
>>>> Je vous met ci joint un epartie de mon fichier :
>>>> http://www.cijoint.fr/cjlink.php?file=cj201003/cijIVB4x9n.xls
>>>>
>>>> Alors les données sont renseignées dans les colonnes C et E.
>>>>
>>>> Quand je viens cliquer sur "cumul semaine" les données sont additionnées
>>>> dans les colonnes H et J.
>>>>
>>>> Et quand je viens cliquer sur cumul annuel, les données sont additionnées
>>>> en M et 0.
>>>>
>>>> C'est à travers ce bouton "cumul annuel" que j'aimerai que le transfert se
>>>> fasse en tenant compte de la donnée en M5.
>>>>
>>>> Le tableau historique commence à partir de la colonne T.
>>>>
>>>> Si l'un d'entre vous arrive à me résourdre mon pb, ca serait vraiment
>>>> parfait!!!
>>>>
>>>> ENcore merci à tout ceux qui prennnent du temps à aider les non expert en
>>>> VBA
>>>>
>>>> "tatanka" a écrit :
>>>>
>>>>> Merci à vous trois pour vos réponses rapide
>>>>>
>>>>> FFO, ca marche nikel sauf que (et oui sinon ce n'est pas drôle) ca ne me
>>>>> reporte pas les données quand j'ai une cellule vide ou égal à 0
>>>>>
>>>>> "FFO" a écrit :
>>>>>
>>>>>> Salut à toi
>>>>>>
>>>>>> Ce code devrait faire :
>>>>>>
>>>>>> Colonne = Range("G4", Cells(4,
>>>>>> Range("IV4").End(xlToLeft).Column).Address).Find(What:=Range("C4"),
>>>>>> After:=Range("G4"), LookIn:=xlValues, LookAt:=xlWhole).Column
>>>>>> i = 5
>>>>>> Do While Range("C" & i) <> ""
>>>>>> If Range("C" & i) <> 0 Then
>>>>>> Cells(65535, Colonne).End(xlUp).Offset(1, 0) = Range("C" & i)
>>>>>> End If
>>>>>> i = i + 1
>>>>>> Loop
>>>>>>
>>>>>>
>>>>>> sur ce lien ton fichier :
>>>>>>
>>>>>> http://www.cijoint.fr/cjlink.php?file=cj201003/cijR7Pvot1.xls
>>>>>>
>>>>>> Aprés l'avoir récupéré et ouvert cliques sur le bouton "Traitement"
>>>>>>
>>>>>> Donnes moi des nouvelles !!!!!
>>>>>>
>>>
>>>
>>> .
>>>


.

1 2