XL 2019 Convertir des données à la suite d'une liste

SEBCRESP

XLDnaute Nouveau
Bonjour à toutes et tous,
Je me permets de solliciter votre aide pour réaliser en automatique une action que j'ai besoin de réaliser hebdomadairement.
En effet chaque semaine, je copie des données dans les premiers onglets "Rapport hebdomadaire" ayant un format prédéfini.
Mon but serait d'avoir un bouton "actualiser" dans le deuxième onglet "liste des appels mensuels" qui copierait à la suite de la liste déjà existante les données sous le format de cette dernière liste.

Je joins un fichier Excel d'exemple à ce message.

Merci de tous ceux qui voudront bien m'aider à trouver une solution simple qui me permettrait de gagner beaucoup de temps.

Cordialement,

SEB
 

Pièces jointes

  • Appels-2023-03-16-19-03-45.xlsx
    11.8 KB · Affichages: 4

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Sdumas, et bienvenu sur XLD,
Un essai en PJ avec :
VB:
Public T, Madate
Sub Transfert()
    Dim L%, i%
    T = [A1].CurrentRegion
    L = 1 + Sheets("liste des appels mensuels").Range("A65500").End(xlUp).Row
    With Sheets("liste des appels mensuels")
        For i = 2 To UBound(T)
            If IsDate(T(i, 1)) Then
                Madate = T(i, 1)
                i = i + 1: InsererLigne L, i
                L = L + 1: i = i + 4
            Else
                i = i - 1: InsererLigne L, i
                L = L + 1: i = i + 3
            End If
            If i > UBound(T) Then Exit Sub
        Next i
    End With
End Sub
Sub InsererLigne(L, i)
    Dim N%
    With Sheets("liste des appels mensuels")
        .Cells(L, 1) = Madate
        For N = 2 To 5
            .Cells(L, N) = T(i + N - 2, 1)
        Next N
    End With
End Sub
Mais il faut respecter la structure 4 lignes par appel.
 

Pièces jointes

  • Appels-2023-03-16-19-03-45.xlsm
    25.2 KB · Affichages: 1

SEBCRESP

XLDnaute Nouveau
Les 4 lignes sont toujours respectées et avec l'exemple fourni c'est juste parfait ! :D

Pour autant, j'abuse un peu car le nombre d'appel par jour et le jour nombre de jour d'appel peuvent être aléatoires et dans ces cas j'ai le sentiment que ca bug !
En pièces jointes le bug et un autre exemple avec plus d'appel et plus de jour d'appel

PS : plusieurs appel sur un même établissement poseraient problème ?

Merci encore
 

Pièces jointes

  • Capture d’écran 2023-03-17 182601.png
    Capture d’écran 2023-03-17 182601.png
    38.1 KB · Affichages: 11
  • Capture d’écran 2023-03-17 192409.png
    Capture d’écran 2023-03-17 192409.png
    58.8 KB · Affichages: 11
  • Capture d’écran 2023-03-17 192440.png
    Capture d’écran 2023-03-17 192440.png
    42.3 KB · Affichages: 12
  • Appels-2023-03-16-19-03-45.xlsm
    26.1 KB · Affichages: 1
Dernière édition:

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re,
Bien confus comme code avec tous ces décalages de pointeurs.
Une PJ plus propre avec :
VB:
Sub Transfert()
    Dim L%, i%, T, Td, Madate: On Error GoTo Fin
    T = [A1].CurrentRegion
    ReDim Td(1 To UBound(T))
    For i = 1 To UBound(T)      ' Met 1 à chaque date de T, sinon 0
        If IsDate(T(i, 1)) Then Td(i) = 1 Else Td(i) = 0
    Next i
    L = 1 + Sheets("liste des appels mensuels").Range("A65500").End(xlUp).Row
    With Sheets("liste des appels mensuels")
        For i = 2 To UBound(T)
            If Td(i) = 1 Then Madate = T(i, 1)
            While Td(i) = 0
                .Cells(L, 1) = Madate
                For N = 2 To 5
                    .Cells(L, N) = T(i + N - 2, 1)
                 Next N
                L = L + 1: i = i + 4
                If Td(i) = 1 Then Madate = T(i, 1)
            Wend
        Next i
    End With
Fin:
End Sub
 

Pièces jointes

  • Appels-2023-03-16-19-03-45 (V2).xlsm
    26.2 KB · Affichages: 2

SEBCRESP

XLDnaute Nouveau
Re,
Bien confus comme code avec tous ces décalages de pointeurs.
Une PJ plus propre avec :
VB:
Sub Transfert()
    Dim L%, i%, T, Td, Madate: On Error GoTo Fin
    T = [A1].CurrentRegion
    ReDim Td(1 To UBound(T))
    For i = 1 To UBound(T)      ' Met 1 à chaque date de T, sinon 0
        If IsDate(T(i, 1)) Then Td(i) = 1 Else Td(i) = 0
    Next i
    L = 1 + Sheets("liste des appels mensuels").Range("A65500").End(xlUp).Row
    With Sheets("liste des appels mensuels")
        For i = 2 To UBound(T)
            If Td(i) = 1 Then Madate = T(i, 1)
            While Td(i) = 0
                .Cells(L, 1) = Madate
                For N = 2 To 5
                    .Cells(L, N) = T(i + N - 2, 1)
                 Next N
                L = L + 1: i = i + 4
                If Td(i) = 1 Then Madate = T(i, 1)
            Wend
        Next i
    End With
Fin:
End Sub
C'est parfait ! tout semble bien fonctionner.
Merci infiniment ! 👍👍
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 915
Membres
101 838
dernier inscrit
Christelle.B86