Piste sur écriture d'une macro !
Edaine
Messages postés
63
Statut
Membre
-
Edaine Messages postés 63 Statut Membre -
Edaine Messages postés 63 Statut Membre -
Bonjour,
J'ai 2 feuilles,
FeDo et FeT, que j'ai défini dans mon code,
Dans FeT, j'ai un tableau en B10:K29,
J'aimerai reporter des valeurs dans ce tableau à partir des colonnes T,U,V de FeDo,
En faite,
Si en T de FeDo, j'ai un chiffre supérieur à 0, alors j'inscris en B11 de FeT, la valeur de la cellule A qui se trouve sur la même ligne que le chiffre supérieur à 0.
Pareil pour U mais cette fois en F11 et V en I11,
Le problème c'est que j'aimerai qu'il passe automatiquement à la ligne si il y a déjà une valeur inscrite sur la FeT
J'étais partie sur un code avec For Next .. mais je n'arrive à .. rien :/
J'ai un code qui pourrait m'inspirer mais rien n'en ressort ..
Le problème c'est qu'il peut arriver que pdt 5-10 lignes il n'y ait rien d'inscrit dans les colonnes...
Merci d'avance pour vos réponse et conseils !
J'ai 2 feuilles,
FeDo et FeT, que j'ai défini dans mon code,
Dans FeT, j'ai un tableau en B10:K29,
J'aimerai reporter des valeurs dans ce tableau à partir des colonnes T,U,V de FeDo,
En faite,
Si en T de FeDo, j'ai un chiffre supérieur à 0, alors j'inscris en B11 de FeT, la valeur de la cellule A qui se trouve sur la même ligne que le chiffre supérieur à 0.
Pareil pour U mais cette fois en F11 et V en I11,
Le problème c'est que j'aimerai qu'il passe automatiquement à la ligne si il y a déjà une valeur inscrite sur la FeT
J'étais partie sur un code avec For Next .. mais je n'arrive à .. rien :/
J'ai un code qui pourrait m'inspirer mais rien n'en ressort ..
a = 2
Do While Cells(a, 2) <> ""
a = a + 1
Loop
i = 2
Do While FeDo.Cells(i,1) <> ""
If Cells(i, 21) > 0 Then
FeT.Cells(a,2).Value=FeDo.Cells(i,1).Value
a = a + 1
End If
i = i + 1
Loop
Le problème c'est qu'il peut arriver que pdt 5-10 lignes il n'y ait rien d'inscrit dans les colonnes...
Merci d'avance pour vos réponse et conseils !
A voir également:
- Piste sur écriture d'une macro !
- Écriture facebook - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Ecriture en gras - Guide
- Ecriture insta - Guide
- Écriture à l'envers miroir - Guide
8 réponses
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Bonjour
macro proposée
End Sub
demo
https://www.cjoint.com/?3GgkkFr4PZK
Pour installer
copier cette macro
clic droit sur le nom d'onglet "fedo" -visualiser le code
coller la macro
Michel
macro proposée
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig1 As Integer, col As Byte, source
Dim lig2 As Byte
If Not Intersect(Target, Range("T1:V1000")) Is Nothing And Target > 0 Then
lig1 = Target.Row
col1 = Target.Column
source = Cells(lig1, 1)
With Sheets("fet")
lig2 = .Range("B10:K29").Find("*", .Range("B10"), , , , xlPrevious).Row
If lig2 = 29 Then GoTo sature
lig2 = lig2 + 1
Select Case col1
Case Is = 20
.Cells(lig2, 2) = source
Case Is = 21
.Cells(lig2, 6) = source
Case Is = 22
.Cells(lig2, 9) = source
End Select
.Activate
End With
End If
Exit Sub
sature:
MsgBox "tableau de destination saturé", vbExclamation
End Sub
demo
https://www.cjoint.com/?3GgkkFr4PZK
Pour installer
copier cette macro
clic droit sur le nom d'onglet "fedo" -visualiser le code
coller la macro
Michel
Wha, je comprends rien au code ...
Mais pourquoi une Worsheet Change?
Je veux le faire moi même en faite... C'est comme une sorte de synthèse.
Mais pourquoi une Worsheet Change?
Je veux le faire moi même en faite... C'est comme une sorte de synthèse.
:s
Enfaite mon fichier se modifie déjà en Worsheet Change ...
Du coup si je met cette macro en Worksheet Change elle va devenir cinglée ^^'
Enfaite mon fichier se modifie déjà en Worsheet Change ...
Du coup si je met cette macro en Worksheet Change elle va devenir cinglée ^^'
Voilà ce que j'ai commencé ..
Sub GRA()
Dim FeDo As Worksheet
Dim FeT As Worksheet
Set FeT = Sheets("Feuille Type")
Set FeDo = Sheets("Douchette")
i = 2
Do While FeDo.Cells(i, 1) <> ""
If FeDo.Cells(i, 21) > 0 Then
FeT.Range("F11").Offset(Application.WorksheetFunction.CountA(Range("F11:F29")), 0).Value = FeDo.Cells(i, 1).Value
FeT.Range("G11").Offset(Application.WorksheetFunction.CountA(Range("G11:G29")), 0).Value = FeDo.Cells(i, 2).Value
FeT.Range("H11").Offset(Application.WorksheetFunction.CountA(Range("H11:H29")), 0).Value = FeDo.Cells(i, 21).Value
a = a + 1
End If
i = i + 1
Loop
End Sub