Bonsoir au forum,

sur cette macro j'ai 4 dropbuttons qui permettent ensuite de choisir dans une liste déroulante puis une deuxième liste

ce que je souhaite, histoire de gagner un clic en général, vu que j'utilise essentiellement un seul drop,

c'est qu'il soit précoché.

Si dans ses propriétés je mets la valeur true, alors la liste n'apparait pas, il faut que je le déclic puis le reclic pour que cela fonctionne.

quelqu'un aurait-il une solution, simple sachant que ce n'est pas une catastrophe non plus.

je ne vous ai mis qu'un code agissant après le choix du drop, les autres sont identiques

cordialement

voici le code :

Private Sub sdpt_Change()

End Sub

Private Sub smeec_Click() 'Liste PS MEEC
Dim i As Integer
Dim nb1 As Integer
Dim nb2 As Integer

ps_dpt.sps.Clear
ps_dpt.sdpt.Clear
                        'recherche dernière cellule renseignée
nb1 = Worksheets("Données").Range("A1000").End(xlUp).Row
nb2 = Worksheets("Données").Range("O1000").End(xlUp).Row
nb1 = nb1 + 1
                     'cherche et renseigne la liste des postes sources de la MEEC
For i = nb1 To nb2
If (Worksheets("Données").Range("O" & i)) = "MEEC" Then
sps = (Worksheets("Données").Range("S" & i))
                      'gestion des doublons
If sps.ListIndex = -1 Then sps.AddItem (Worksheets("Données").Range("S" & i))
End If
Next i
ps_dpt.sps = ""
End Sub





Private Sub UserForm_Click()

End Sub

Private Sub validpsdpt_Click()
ActiveSheet.Unprotect Password = "benevent"
'renseignement de la cellule du ps
Range("Z1") = ps_dpt.sps.Value
'renseignement de la cellule du dpt
Range("Z2") = ps_dpt.sdpt.Value
Unload ps_dpt
End Sub
Private Sub sps_DropButtonClick()
Dim i As Integer
Dim nb1 As Integer
Dim nb2 As Integer
Dim maille As String
        If ps_dpt.smeec = True Then
        maille = "MEEC"
        End If
        If ps_dpt.saehv = True Then
        maille = "AEHV"
        End If
        If ps_dpt.sarc = True Then
        maille = "ARC"
        End If
        If ps_dpt.sarco = True Then
        maille = "ARCO"
        End If
        

                        'recherche dernière cellule renseignée
nb1 = Worksheets("Données").Range("A1000").End(xlUp).Row
nb2 = Worksheets("Données").Range("O1000").End(xlUp).Row
nb1 = nb1 + 1
                     'cherche et renseigne la liste des départs par PS sélectionné
For i = nb1 To nb2
           If ps_dpt.sps.Value = Worksheets("Données").Range("S" & i) And maille = Worksheets("Données").Range("O" & i) Then
            ps_dpt.sdpt.AddItem Worksheets("Données").Range("Q" & i)
            End If
Next i
End Sub

il manquait un fichier

J'ai trouvé pourquoi parfois elle ne fonctionnait pas : il faut faire copier coller des noms situés dans actes par joueur vers récapitulatif (1ère page), sinon la consolidation des données ne fonctionne pas.

Il faut donc arrêter la macro avant la consolidation pour retrouver les noms, cette manip n'est nécessaire que la première fois

à bientôt

Je le passe en résolu, au boulot, elle marche nickel !

François

Bonsoir,

j'y suis presque, le tableau actes par joueur prend la forme de l'autre mais la consolidation des données ne fonctionne pas, du moins sur cet exemple, elle fonctionne très bien sur les fichiers d'origine et là, je coince, moi pas comprendre pourquoi un coup ça marche et un coup ça ne marche pas.

Je vous joins les fichiers exemple avec la macro qui va avec !

merci de vos réponses pour éclairer ma lanterne

François

j'ai trouvé tout seul comme un grand avec l'aide de forums

question 1 :

For h = 1 To 1000
        Cells(h, 1).Offset(0, 2) = Cells(h, 1)
    Next h

question 2 :

For i = 6 To 1001 Step 14
        Cells(i, 2).Offset(-5, 3) = Cells(i, 2)
    Next i
    
    For j = 7 To 1002 Step 14
        Cells(j, 2).Offset(-6, 4) = Cells(j, 2)
    Next j
    
    For k = 8 To 1003 Step 14
        Cells(k, 2).Offset(-7, 5) = Cells(k, 2)
    Next k

à bientôt

Bonjour le forum,

J'ai de nouveau besoin de votre aide

sur le code suivant, j'aurai souhaité, plutôt que de tout rentrer à la main qu'il y ai une chaîne automatique, c'est à dire que la macro me copie et colle toutes les cellules de A1:A1000 par exemple avec un pas de 14, (to step ?)

Sheets("Sheet0").Range("A1,A15,A29,A43,A57,A71,A85,A99").Copy Destination:=Sheets("FEVRIER").Range("B3")

Sur son "grand frère" avec collage spécial, j'aurai souhaité la même chose :Sheets("Sheet0").Range("B6:B8").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Fevrier").Select
    Range("D3").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

pas de 14 égalementmais collage pas de 1 ce qui copier en B6:B8 va en D3, ce qui est copié en B20:B22 va en D4

Je ne pense pas que ce soit irréalisable mais je galère un peu !

En vous remerciant

Bonsoir à tous,

voici deux fichiers : le premier que j'ai appelé acte par joueur est dans la vraie vie un export d'un logiciel et c'est export est présenté de cette manière nom + date en A1 puis une suite (tous les A+14)

l'export présente aussi 3 stats en B6, B7, B8 puis une suite (B+14), pour que ces stats deviennent exploitables, un second fichier a été créé

j'ai fait une macro qui copie et colle les infos du premier vers le deuxième mais je la trouve assez brute.

La liste de noms de joueurs peut varier d'une équipe à l'autre (elle n'est pas destinée qu'à moi), donc je souhaiterais sans avoir à aligner les lignes de code que ça se fasse naturellement selon la suite exprimée plus haut et  selon le nombre de joueurs.

Est-il possible de récupérer automatiquement le prénom malgré les dates qui apparaissent dans la même cellule ?

Est il possible de supprimer la vision psychédélique quand le copie coller se fait ?

J'essaie aussi de conserver les couleurs dans les colonnes, mais je pense devoir y arriver avec la MFC

Merci à vous de votre aide !

Bonjour Myta, ça bloque à 1024 caractères, y a t il un moyen de dépasser cette limite

cordialement

François

Bonsoir Myta

comment intégrer la msgbox au code, je n'en suis pas là dans vba, en le mettant en fin de code ça m'affiche 0

mais ça ne me donne pas la longueur de chaîne

en te remerciant

François