XL 2016 Modification Vba transfert de lignes

[Shpountz]

Bonjour à tous
j'ai une macro Vba mais j'ai besoin de l'adapter

Celle-ci me crée de nouveaux onglets mais surtout me supprime d'autres onglets de mon classeur ce que je veux eviter a tout prix

Est il possible de la modifier ?

Je joint un fichier avec les explications

Merci d'avance


Sub TransfertFormeetClasseOnglets()
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

'***********************************************
'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
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

 

[Robert]

Bonjour Shpountz, bonjour le forum,

Tu as récupéré cette macro, ou bien c'est moi qui te l'ai envoyée, car je reconnais ma patte... Tu l'as aussi modifiée car l'onglet source OS n'étant pas défini, le code plante dès la ligne 19 :

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

Je te laisse le soin de corriger...

 

[Staple1600]

Bonjour le fil, Robert

L'enigme est donc résolue

https://www.excel-downloads.com/thr...ets-grace-a-un-modele.20038557/#post-20275505

Et César s'appelait donc Robert

 

[Robert]

Re,

Quand est-ce que sort la Série : Les Experts de Rohazon avec l'Agrafe dans le rôle de l'enquêteur ?...

 

[Staple1600]

Re

Moi, je ne fais rien.
Tout le crédit va à Xenforo (et à ses fonctionnalités)

Et Bonjour à toi aussi Robert...

 

[Robert]

Re,

Oui pardon !.... Bonjour l'Agrafe...

 

[Shpountz]

Bonjour Robert et bonjour à tous
Je ne sais plus qui m'a envoyé cette macro mais je l'en remercie

Quoi qu'il en soit je suis bien incapable de la modifier

Si j'ai bien saisis je dois donc lui donner le nom de l'onglet source ?
donc si je veux l'adapter pour d'autres onglets je lui donne un nom different pour chaque onglet que je souhaite traiter ?
Je souhaiterais eviter qu'elle :
- Crée de nouveaux onglets puisque c'est deja fait
- supprime tout les onglets (ce qui est embetant)

donc c'est avec plaisir que je rends a Cesar ce qui appartient à César

merci d'avance pour les réponses
Francois

 

[Robert]

Re,

Désolé mais j'ai pas envie de me replonger dans un code qui n'étais pas, au départ, fait pour ce fichier...

 

[Shpountz]

Ok je comprends
Merci quand même
Amicalement
Francois