Transfert de données sans couper les n° des élèves d'un tableau à l'autre

Bonjour le forum

je dois transférer des données verts ma feuille liste sans couper les numéros, je m'explique chaque élève à son numéro, il suit plusieurs cours....donc plusieurs fois le même n°, dans l’importation de données, si pas assez de place dans le tableau pour mettre l'élève et tous ces cours, alors on passe au tableau suivant. Donc ici dans le fichier, le n°15 ne peut pas allez en tableau 1 car il n'y a plus q'une ligne de disponible alors qu'il compte 2 n°.

En Résumé, a chaque fois qu'il n'y a pas assez de ligne disponible pour mettre tous les n°de l'élève, il envois sur le tableau suivant...

J'espère que vous pourrez me donner un peu d'aide, ci -joint le fichier pour plus de clartés

Bonsoir The Speedy, bonsoir le forum,

Pas clair ton histoire... Trop speedée peut-être.

Pourquoi le tableau 1 comporte 27 lignes blanches et le tableau 2, 28 ?

Puisqu'il y a 61 numéro il faudra 3 tableaux. Pourquoi le troisième tableau n'est pas créé ?

Ou plutôt :

Combien de ligne blanche par tableau ? La marco fera le reste...

En résumé : encore un exemple à la mord-moi...

Bonsoir ThauThème,

Je suis à coté de mes chaussettes...

Il y aura 27 lignes blanches par tableau...

Il peut y avoir plus de 2 tableaux car la liste peut-être variable....

j'ai toujours du mal à exprimer ce que je veux....

Merci

Oli

Bonjour,

Une proposition !?

Cdlt.

Re,

Esaie comme ça :

Sub Macro1()
Dim OL As Worksheet 'déclare la variable OL (Onglet Liste)
Dim OD As Worksheet 'déclare la variable OD (Onglet Donnees)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim NF As Integer 'déclare la variable NF (Nombre de Fois)
Dim PAC As Range 'déclare la variable PAC (Plage À Copier)
Dim J As Integer 'déclare la variable J (incrément)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim PAS As Range 'déclare la variable PAS (Plage À Supprimer)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Set OL = Worksheets("Liste") 'définit l'onglet OL
Set OD = Worksheets("Donnees") 'définit l'onglet OD
OL.Rows("3:" & Application.Rows.Count).Delete 'supprime d'éventuelles anciennes données de l'onglet OL
DL = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row 'de'finit la dernière ligne éditée DL de la colonne A de l'onglet OD
NF = Int(DL / 27) + 1 'de'finit le nombre de fois NF
Set PAC = OL.Range("A1:H2") 'définit la plage à copier PAC
For J = 1 To NF 'boucle 1 : de 1 au nombre de fois NF
    TV = OD.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
    For I = 29 To 2 Step -1 'boucle 2 : inversée des lignes 29 à 2 en remontant
        On Error Resume Next 'gestion des erreur (en cas d'erreur passe à la ligne suivante)
        'condition : si le nom/prénom de la ligne I est différent du nom/prenom de la ligne I-1
        If Not TV(I, 2) & TV(I, 3) = TV(I - 1, 2) & TV(I - 1, 3) Then 'dans le dernier tableau TV(I,...) va générer une erreur
            DL = I - 1 'redéfinit la ligne DL
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    On Error GoTo 0 'annule la gestion des erreur
    Set DEST = OL.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    Set PAS = OD.Rows("2:" & DL) 'définit la plage à supprimer PAS
    PAS.Copy DEST 'copie la plage à supprimer dans DEST
    PAS.Delete 'supprime la plage à supprimer PAS
    If Not J = NF Then 'condition : si J n'est pas la dernière fois NF
        Set DEST = OL.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'redéfinit la cellule de destination DEST
        PAC.Copy DEST.Offset(1, 0) 'copy la plage à copier dans DEST
    End If 'fin de la condition
Next J 'prochaine fois de la boucle 1
End Sub

[Édition

Bonsoir jean-Éric, nos post se sont croisés... Je viens d'ouvrir ton fichier. Quelle classe !..[/color]

Bonsoir le Forum, Jean-Eric, ThauThème

@Jean-Eric, très belle proposition mais coupe le n° des élèves quand on passe au tableau suivant...

@ThauThème, c'est exactement ce qu'il me fallait....

j'ai ajouter le reste des colonnes, est il possible de transférer les cours de musique dans le domaine musique, danse dans le

domaine....exemple dans le fichier ci-joint....

Encore merci pour votre aide à tout les deux....

Oli

Re,

Je ne comprends pas ta remarque !...

Cdlt.

Nota: j'ai compris !...

Re,

La version 02 adaptée... Le code :

Sub Macro1()
Dim OL As Worksheet 'déclare la variable OL (Onglet Liste)
Dim OD As Worksheet 'déclare la variable OD (Onglet Donnees)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim NF As Integer 'déclare la variable NF (Nombre de Fois)
Dim PAC As Range 'déclare la variable PAC (Plage À Copier)
Dim J As Integer 'déclare la variable J (incrément)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim PAS As Range 'déclare la variable PAS (Plage À Supprimer)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim TL() As Variant 'déclare la variable TL (tableau des Ligne)
Dim K As Integer 'déclare la variable K (incrément)
Dim COL As Byte 'déclare la variable COL (COLonne)

Set OL = Worksheets("Liste") 'définit l'onglet OL
Set OD = Worksheets("Donnees") 'définit l'onglet OD
OL.Rows("3:" & Application.Rows.Count).Delete 'supprime d'éventuelles anciennes données de l'onglet OL
Application.ScreenUpdating = False 'masque les rafraîchissemetns d'écran
DL = OD.Cells(Application.Rows.Count, "A").End(xlUp).Row 'de'finit la dernière ligne éditée DL de la colonne A de l'onglet OD
NF = Int(DL / 27) + 1 'de'finit le nombre de fois NF
Set PAC = OL.Range("A1:H2") 'définit la plage à copier PAC
For J = 1 To NF 'boucle 1 : de 1 au nombre de fois NF
    TV = OD.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
    For I = 29 To 2 Step -1 'boucle 2 : inversée des lignes 29 à 2 en remontant
        On Error Resume Next 'gestion des erreur (en cas d'erreur passe à la ligne suivante)
        'condition : si le nom/prénom de la ligne I est différent du nom/prenom de la ligne I-1
        If Not TV(I, 2) & TV(I, 3) = TV(I - 1, 2) & TV(I - 1, 3) Then 'dans le dernier tableau TV(I,...) va générer une erreur
            DL = I - 1 'redéfinit la ligne DL
            Exit For 'sort de la boucle 2
        End If 'fin de la condition
    Next I 'prochaine ligne de la boucle 2
    On Error GoTo 0 'annule la gestion des erreur
    Set DEST = OL.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'définit la cellule de destination DEST
    Set PAS = OD.Rows("2:" & DL) 'définit la plage à supprimer PAS
    TMP = PAS
    PAS.Delete 'supprime la plage à supprimer PAS
    K = 1
    For I = 1 To UBound(TMP, 1)
        If TMP(I, 1) = "" Then GoTo suite
        ReDim Preserve TL(1 To 8, 1 To K)
        TL(1, K) = TMP(I, 1)
        TL(2, K) = TMP(I, 2) & " " & TMP(I, 3)
        Select Case TMP(I, 7)
            Case "DOMAINE DE LA MUSIQUE"
                COL = 3
            Case "DOMAINE DES ARTS DE LA PAROLE ET DU THEATRE"
                COL = 5
            Case "DOMAINE DE LA DANSE"
                COL = 7
        End Select
        TL(COL, K) = TMP(I, 4)
        TL(COL + 1, K) = TMP(I, 5) & "(" & TMP(I, 6) & ")"
        K = K + 1
    Next I
suite:
    DEST.Resize(UBound(TL, 2), 8).Value = Application.Transpose(TL)
    If Not J = NF Then 'condition : si J n'est pas la dernière fois NF
        Set DEST = OL.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0) 'redéfinit la cellule de destination DEST
        PAC.Copy DEST.Offset(1, 0) 'copy la plage à copier dans DEST
    End If 'fin de la condition
Next J 'prochaine fois de la boucle 1
Application.ScreenUpdating = True 'affiche les rafraîchissemetns d'écran
End Sub

Le fichier :

Bonjour ThauThème ,

Grand merci pour cette nouvelle version....la répartition se fait correctement....

J'aimerais te demander une dernière petite chose, est-ce possible que l'entête copiée (A1:H2), peut débuter sur chaque nouvelle page tout en conservant le pas afin qu'a l'impression je puisse avoir un tableau par page....

Je te remercie vivement

Très belle journée...

Oli

Re,

La version 03 en pièce jointe (après j'arrête !...) :

Bonsoir ThauThème,

C'est parfait, c'est que je désirais.....

Je te remercie vivement pour l'aide apportée et surtout le temps consacré

Je te souhaite d'excellente fêtes de fin d'année....

@+

Oli

Bonsoir ThauThème,

j'ai parlé un peu trop vite...désolé

Il n' y a pas une autre solution, j'aurais voulu le même nombre de ligne sur chaque page, car je dois insérer un sous total sur la ligne que j'ai laissé libre....

Donc L'entête A1:H2 devrait débuté en A1, le suivant en A31, A62, A93,A124.......

J'espère que tu voudras bien le modifier.....ce sera la dernière modification...

Oli

Re

Ou plutôt :

Bonsoir ThauThème,

Quelle est la différence entre les deux dernières versions ?

Voilà, c'est top nickel......

Merci beaucoup.....

@+

Oli

Re,

Une ligne en trop dans la version 4...

Bonsoir ThauThème,

J'ai un petit bug, j'ai agrandi ma liste de données, ici lors du transfert, il me laisse deux noms dans la feuilles donnees....et dans la feuille liste à partir de la ligne 157 , il ajoute un cours de barre au sol dans le domaine de la danse jusque qu'à la dernière feuille....

Oli

Re,

La version 6 corrigée :