XL 2019 Recopier mes feuilles dans mon USF

Phil Du59 · Mercredi à 10:34

Bonjour à tous
Je reviens vers vous pour améliorer mon tableau afin d’avoir une meilleure visibilité et de regrouper les données de mes feuilles sur mon USF , si tout est possible bien sur .
Pour entrer mes données je passe par NEW QSO

1° Dans la Listbox 1 , recopier la ligne de B2 à H2 de le feuille LOG .

2° Dans la Listbox 2 (le grand cadre) , recopier les entrées des colonnes B C D E F G et H de façon à voir toujours le dernier entré visible en bas , donc avec la liste qui monte au fur et à mesure (si c’est possible)

3° Dans la Listbox 3 (QSO N°) , recopier la case A2 de la feuille LOG

4° Dans la Listbox 4 (DXCC WORKED) , recopier la case L1 de la feuille STATS

5° Dans la Listbox 5 (celle en bas) , recopier de H2 à Q31 de la feuille STATS (par ordre croissant si possible)

Je pense n’avoir rien oublié dans mes demandes , en tout cas n’hésitez pas à demander si besoin , en fait tout ce que je rentre dans la partie haute de mon USF serait visible dans les ListBox pour avoir un aperçu global .

Par avance Merci , Philippe

job75 · Hier à 17:19

Phil Du59 à dit:
Oui sans les doublons merci

Avec ce code il n'y a plus de doublon dans le 2ème tableau de la feuille STATS :

VB:

Private Sub Worksheet_Activate()
    Dim DL&, Tablo, i&, Dxcc, Tablo2(), n&, L&, C%
    [H2:Q41].ClearContents
    DL = Sheets("LOG").[C10000].End(xlUp).Row
    Tablo = Sheets("LOG").Range("C3:D" & DL) 'au moins 2 éléments
    For i = 1 To UBound(Tablo)
        Dxcc = Val(Left(Tablo(i, 1), 3))
        If Trim(Tablo(i, 1)) Like (Dxcc) & "*" Then
            ReDim Preserve Tablo2(n) 'base 0
            Tablo2(n) = Dxcc
            n = n + 1
        End If
    Next i
    If n = 0 Then Exit Sub
    tri Tablo2, 0, UBound(Tablo2)
    L = 2: C = 8
    Cells(L, C) = Tablo2(0): C = C + 1
    For i = 1 To UBound(Tablo2)
        If...

Phil Du59 · Hier à 17:25

TooFatBoy à dit:
As-tu essayé d'allouer le ListCount (probablement faut-il retrancher 1) de la ListBox au ListIndex de ladite ListBox ?

Si vous me dites ou regarder cela car dans les propriétés de la Listbox 2 si c'est bien là , je n'ai pas trouvé de ListCount mais je doute être au bon endroit ...

Phil Du59 · Hier à 17:59

job75 à dit:

Avec ce code il n'y a plus de doublon dans le 2ème tableau de la feuille STATS :

VB:

Private Sub Worksheet_Activate()
    Dim DL&, Tablo, i&, Dxcc, Tablo2(), n&, L&, C%
    [H2:Q41].ClearContents
    DL = Sheets("LOG").[C10000].End(xlUp).Row
    Tablo = Sheets("LOG").Range("C3:D" & DL) 'au moins 2 éléments
    For i = 1 To UBound(Tablo)
        Dxcc = Val(Left(Tablo(i, 1), 3))
        If Trim(Tablo(i, 1)) Like (Dxcc) & "*" Then
            ReDim Preserve Tablo2(n) 'base 0
            Tablo2(n) = Dxcc
            n = n + 1
        End If
    Next i
    tri Tablo2, 0, UBound(Tablo2)
    L = 2: C = 8
    Cells(L, C) = Tablo2(0): C = C + 1
    For i = 1 To UBound(Tablo2)
        If Tablo2(i) <> Tablo2(i - 1) Then
            Cells(L, C) = Tablo2(i)
            C = C + 1
            If C = 18 Then C = 8: L = L + 1
        End If
    Next i
End Sub

Et pour afficher les 14 dernières lignes de ListBox2 utilisez sa propriété .TopIndex dans le code de la feuille LOG :

VB:

    If plage.Row = 2 Then .Clear Else .TopIndex = .ListCount - 14

Merci infiniment Job superbe travail sur mon tableau vous avez tout résolu selon mes attentes , maintenant il me reste à comprendre un peu pour apprendre et voir si je serais capable de faire un ajout seul ou vous me reverrez prochainement , encore Merci à vous tous qui ont pris le temps de m'aider , Bon week-end Philippe .

TooFatBoy · Hier à 18:19

Phil Du59 à dit:
Si vous me dites ou regarder cela car dans les propriétés de la Listbox 2 si c'est bien là , je n'ai pas trouvé de ListCount mais je doute être au bon endroit ...

En fait je disais d'ajouter cette ligne à ton code VBA, pour voir si ça fonctionnait :

VB:

ListBox2.ListIndex = ListBox2.ListCount - 1

job75 · Hier à 18:22

Au post #30 j'avais écrit .TopIndex = .ListCount - 14 en fait il faut .TopIndex = .ListCount j'ai corrigé.

Et dans la feuille STATS j'ai ajouté If n = 0 Then Exit Sub

job75 · Hier à 18:23

Pour finir, ce n'est pas votre post #32 qu'il faut cocher comme solution mais mon post #30.

Merci de corriger.

Phil Du59 · Hier à 18:26

job75 à dit:
Ce n'est pas votre post #32 qu'il faut cocher comme solution mais mon post #30.

Merci de corriger.

Oupss désolé je vais modifié , pardon , j'ai été trop vite en disant que tout était ok car en effaçant le tableau j'ai 1 voir 2 bugs mais j'y regarde

job75 · Hier à 18:36

Phil Du59 à dit:
j'ai été trop vite en disant que tout était ok car en effaçant le tableau j'ai 1 voir 2 bugs mais j'y regarde

Oui voir mon post #34.

Phil Du59 · Hier à 18:50

job75 à dit:
Oui voir mon post #3

job75 à dit:
Oui voir mon post #34.

J'ai celui ci quand j'efface tout le tableau avec le dernier fichier

job75 · Hier à 19:02

J'ai bien dit que dans la feuille STATS j'ai ajouté If n = 0 Then Exit Sub le fichier du post #30 a été mis à jour.

Phil Du59 · Hier à 19:37

job75 à dit:

Avec ce code il n'y a plus de doublon dans le 2ème tableau de la feuille STATS :

VB:

Private Sub Worksheet_Activate()
    Dim DL&, Tablo, i&, Dxcc, Tablo2(), n&, L&, C%
    [H2:Q41].ClearContents
    DL = Sheets("LOG").[C10000].End(xlUp).Row
    Tablo = Sheets("LOG").Range("C3:D" & DL) 'au moins 2 éléments
    For i = 1 To UBound(Tablo)
        Dxcc = Val(Left(Tablo(i, 1), 3))
        If Trim(Tablo(i, 1)) Like (Dxcc) & "*" Then
            ReDim Preserve Tablo2(n) 'base 0
            Tablo2(n) = Dxcc
            n = n + 1
        End If
    Next i
    If n = 0 Then Exit Sub
    tri Tablo2, 0, UBound(Tablo2)
    L = 2: C = 8
    Cells(L, C) = Tablo2(0): C = C + 1
    For i = 1 To UBound(Tablo2)
        If Tablo2(i) <> Tablo2(i - 1) Then
            Cells(L, C) = Tablo2(i)
            C = C + 1
            If C = 18 Then C = 8: L = L + 1
        End If
    Next i
End Sub

Et pour afficher les 14 dernières lignes de ListBox2 utilisez sa propriété .TopIndex dans le code de la feuille LOG :

VB:

    If plage.Row = 2 Then .Clear Else .TopIndex = .ListCount

En effet je n'avais pas vu la MàJ du #30 , tout est nickel , encore merci pour votre temps , bonne soirée .

XL 2019 Recopier mes feuilles dans mon USF

Phil Du59

XLDnaute Nouveau

Pièces jointes

job75

Phil Du59

XLDnaute Nouveau

Phil Du59

XLDnaute Nouveau

TooFatBoy

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

Phil Du59

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Phil Du59

XLDnaute Nouveau

Pièces jointes

job75

XLDnaute Barbatruc

Phil Du59

XLDnaute Nouveau

Discussions similaires

XL 2019 Recopier mes feuilles dans mon USF

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Nouveau

Discussions similaires

Privacy & Transparency

Privacy & Transparency