Problème VBA
Fermé
matm
Messages postés
3
Date d'inscription
mercredi 17 juillet 2013
Statut
Membre
Dernière intervention
19 juillet 2013
-
18 juil. 2013 à 15:01
matm Messages postés 3 Date d'inscription mercredi 17 juillet 2013 Statut Membre Dernière intervention 19 juillet 2013 - 19 juil. 2013 à 08:03
matm Messages postés 3 Date d'inscription mercredi 17 juillet 2013 Statut Membre Dernière intervention 19 juillet 2013 - 19 juil. 2013 à 08:03
4 réponses
Morgothal
Messages postés
1235
Date d'inscription
jeudi 22 avril 2010
Statut
Membre
Dernière intervention
19 mai 2015
179
18 juil. 2013 à 15:51
18 juil. 2013 à 15:51
Hello,
Peux tu poster une version anonymisée de ton classeur, en suivant ce tuto ?
A+ !
Peux tu poster une version anonymisée de ton classeur, en suivant ce tuto ?
A+ !
michel_m
Messages postés
16593
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
23 mars 2023
3 292
18 juil. 2013 à 18:08
18 juil. 2013 à 18:08
Bonjour
en A3 on voit que la valeur de la cellule est 1 donc je sélectionne la cellule qui se trouve deux lignes au dessus
Tu nous expliques ?
en A3 on voit que la valeur de la cellule est 1 donc je sélectionne la cellule qui se trouve deux lignes au dessus
Tu nous expliques ?
matm
Messages postés
3
Date d'inscription
mercredi 17 juillet 2013
Statut
Membre
Dernière intervention
19 juillet 2013
19 juil. 2013 à 07:43
19 juil. 2013 à 07:43
https://www.cjoint.com/?3GthOHDLDHc
Ci-dessus le lien ou vous trouverez mon fichier
Ci-dessus le lien ou vous trouverez mon fichier
matm
Messages postés
3
Date d'inscription
mercredi 17 juillet 2013
Statut
Membre
Dernière intervention
19 juillet 2013
19 juil. 2013 à 08:03
19 juil. 2013 à 08:03
J'ai ce code ci mais le problème c'est que ça me met pas le nom des personnes ou je veux. C'est à dire s'il y a trois personne qui ont une cotation >= 1 alors il y aura 3 tableaux et chaque nom se trouvera dans un tableau
Private Sub CommandButton1_Click()
Dim Copiage As Range, Dl As Long, Dc As Integer, noms, Retenu()
Dim Nfois As Integer, x As Integer, y As Integer
On Error Resume Next
Set Copiage = Application.InputBox("Plage à copier", Type:=8)
y = 0
If Not Copiage Is Nothing Then
With Sheets("Feuil3")
Dc = .Cells(1, .Columns.Count).End(xlToLeft).Column
noms = .Range(.Cells(1, 1), .Cells(3, Dc))
Nfois = UBound(noms, 2)
End With
For x = 1 To UBound(noms, 2)
If noms(3, x) >= 1 Then
y = y + 1
ReDim Preserve Retenu(1 To y)
MsgBox noms(1, x)
Retenu(y) = noms(1, x)
End If
Next x
For x = 1 To UBound(Retenu)
With Sheets("Feuil2")
Dl = .Range("A" & .Rows.Count).End(xlUp).Row + 1
Copiage.Copy .Range("A" & Dl)
.Range("G" & x + 1) = Retenu(x)
End With
Next x
Else
Exit Sub
Err.Clear
End If
End Sub
Private Sub CommandButton1_Click()
Dim Copiage As Range, Dl As Long, Dc As Integer, noms, Retenu()
Dim Nfois As Integer, x As Integer, y As Integer
On Error Resume Next
Set Copiage = Application.InputBox("Plage à copier", Type:=8)
y = 0
If Not Copiage Is Nothing Then
With Sheets("Feuil3")
Dc = .Cells(1, .Columns.Count).End(xlToLeft).Column
noms = .Range(.Cells(1, 1), .Cells(3, Dc))
Nfois = UBound(noms, 2)
End With
For x = 1 To UBound(noms, 2)
If noms(3, x) >= 1 Then
y = y + 1
ReDim Preserve Retenu(1 To y)
MsgBox noms(1, x)
Retenu(y) = noms(1, x)
End If
Next x
For x = 1 To UBound(Retenu)
With Sheets("Feuil2")
Dl = .Range("A" & .Rows.Count).End(xlUp).Row + 1
Copiage.Copy .Range("A" & Dl)
.Range("G" & x + 1) = Retenu(x)
End With
Next x
Else
Exit Sub
Err.Clear
End If
End Sub