Deplacer certaines lignes d'un onglet dans nouveaux onglets

Bonjour à tous

Je souhaiterais déplacer certaines lignes d'un onglet "Forme et Classe" dans des onglets deja créer...

Mon souci (et ce n'est pas le seul) est que :

• Le nombre de lignes a déplacer n'est jamais identique
• Les onglets sont déja créer avec leur nom
• il faut déplacer les lignes dans les nouveaux onglets à des endroits précis (en ligne 71 et en ligne 94)
• Dans l'onglet ou se trouvent les lignes à déplacer le nom des onglets ou il faut déplacer les lignes n'est a l'heure actuelle pas défini (exemple "Course: R.3-C.1" devenant l'onglet "R3C1")

Je joint un fichier avec 3 onglets déja créer

En vous remerciant d'avance pour votre aide

Amicalement

François

Bonsoir François, bonsoir le forum,

Essaie comme ça :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Long 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Long 'déclare la variable I (Incrément)
Dim J As Long 'déclare la variable J (incrément)
Dim X As Long 'déclare la variable X (incrément)
Dim TLN() As Variant 'déclare la variable TLN (Tableau des Lignes à Numéro)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim LD1 As Long, LF1 As Long, LD2 As Long, LF2 As Long 'déclare les variables LD1, LF1, LD2 et LF2 (Ligne Début et ligne Fin)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran

'*****************************************************
'suppression de tous les onglet sauf "Forme et Classe"
'*****************************************************
Set OS = Worksheets("Forme et Classe") 'définit l'onglet source OS
Application.DisplayAlerts = False 'masque les message d'Excel (en cas de suppression d'un onglet par exemple)
For Each O In Sheets 'boucle sur tous les onglets O du classeur
    If Not O.Name = OS.Name Then O.Delete 'si l'onglet O n'est pas l'onglet OS, supprime l'onglet O
Next O 'prochaine onglet de la boucle
Application.DisplayAlerts = True 'affiche les message d'Excel

'***********************************************
'Recherche des ligne contenant "N°" en colonne A
'***********************************************
DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet OS
TV = OS.Range(OS.Cells(1, 1), OS.Cells(DL, 1)) 'définit le tableau des valeurs TV
For I = 1 To DL 'boucle sur toutes les lignes I du tableau des valeur TV
    'si la donnée ligne I colonne 1 de TV est égale à "N°", redimensionne le tableau TLN, récupère dans TLN(X) la ligne I, incrémente X
    If TV(I, 1) = "N°" Then ReDim Preserve TLN(X): TLN(X) = I: X = X + 1
Next I 'prochaine ligne de la boucle
'tableau TLN contient désormais toutes les lignes où la colonne A contient "N°"

'*********************************************
'Renvoie des donnés dans leur onglet respectif
'*********************************************
For I = 0 To UBound(TLN) 'boucle 1 : sur tous les éléments du tableau TLN
    Sheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet en dernière position
    ActiveSheet.Name = TV(TLN(I) - 1, 1) 'renomme l'onglet (avec la valeur de la donné ligne (TLN(I) moins une,  colonne 1 de TV)
    Set OD = ActiveSheet 'définit l'onglet destination OD
    LD1 = TLN(I) 'définit la ligne de début LD1
    For J = LD1 To DL 'boucle 2 : sur toutes les lignes J de TV (de LD1 à DL)
        'si la donnée ligne J colonne 1 de TV est égale à "Rang : ", définit les lignes LF1, LD2 et LF2 et sort de la boucle
        If TV(J, 1) = "Rang : " Then LF1 = J - 1: LD2 = J + 1: LF2 = J + 11: Exit For
    Next J 'prochaine ligne de la boucle 2
    'copie les lignes LD1 à LF1 de l'onglet source et les colle dans A71 de l'onglet destination
    OS.Rows(LD1 & ":" & LF1).Copy OD.Range("A71")
    'copie les lignes LD2 à LF2 de l'onglet source et les colle dans A94 de l'onglet destination
    OS.Rows(LD2 & ":" & LF2).Copy OD.Range("A94")
    ActiveWindow.ScrollRow = 71 'place la ligne 71 en haut de la fenêtre
Next I 'prochain élément de la boucle 1
MsgBox "Traitement des données terminé !" 'message
End Sub

Bonjour ThauTheme

Un grand merci de vous être penché sur mon cas.

Cela fonctionne, mais j'en étais convaincu d'avance.

J'ai juste quelques petits soucis

- Cette macro s'insère dans un classeur dans lequel il y a d'autres onglets et lorsque je la lance elle me supprime tout... Serait il possible que les données soit envoyés dans les onglets existants et ne pas supprimer les autres onglets ?

- Les onglets dans ce classeur sont nommer automatiquement en fonction d'un contenu de l'un des onglets. Par obligation ils se nomment R1C1, R1C2 etc il faudrait donc éliminer le "-"

En tout cas bravo et merci pour votre aide

Amicalement

François

Re,

Le dernier fichier que tu me proposes n'a rien à voir avec le précédent !... Je vais pas m'amuser à refaire le code selon ton bon vouloir. Il est suffisamment commenté pour te permettre de le modifier...

Bonjour ThauTheme

Je comprends.

Je vis tenter de me débrouiller tout seul.

Encore un grand merci pour ton aide qui m'a été précieuse.

Très amicalement

François