Macro pour copier, défusionner et ....
Résolu
Emi80110 Messages postés 68 Date d'inscription Statut Membre Dernière intervention -
Bonjour à tous (et toutes :-) )
voici le lien du fichier concerné par ma demande ci-dessous (ca n'est qu'un échantillon)
https://www.cjoint.com/c/MFAmxvZMydt
dans l'onglet feuill1 le fichier d'origine
dans l'onglet feuill2 le résultat dont j'aurai besoin
MA DEMANDE:
J'ai dans ce fichier les colonnes A et B qui fusionnent les cellules selon certaines données.
J'aurai besoin de trouver une macro qui puisse copier cet onglet mais sans fusionner les cellules et surtout en rappelant la donnée fusionnée sur chaque ligne concernée par cette donnée.
Je ne sais pas si je suis claire... c'est pourquoi j'ai mis le résultat dont j'aurai besoin en feuill2.
Mon fichier d'origine traite en réalité plus de 10 000 lignes c'est pourquoi je ne peux pas me permettre de le faire intégralement à la main sachant que je l'éditerai chaque semaine.
Merci d'avance pour votre aide :-)
- Macro pour copier, défusionner et ....
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Comment copier une vidéo youtube - Guide
- Super copier - Télécharger - Gestion de fichiers
- Jitbit macro recorder - Télécharger - Confidentialité
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
4 réponses
Bonjour,
Un autre code, qui ne prend en compte que les cellules fusionnées :
Sub defusion()
Dim Cel As Range, Plg As Range
For Each Cel In ActiveSheet.UsedRange
If Cel.MergeCells Then
Set Plg = Cel.MergeArea
Cel.UnMerge: Plg.Value = Cel.Value
End If
Next Cel
End Sub
Bonne journée
Bonjour
Option Explicit
Const FS = "Feuil1"
Const FB = "Feuil2"
Const coage = 1
Const cocon = 2
Const lideb = 2
Public Sub ok()
Dim cel As Range, contrat As String, adr As String
Dim li As Long, lifin As Long, lili As Long
Application.ScreenUpdating = False
' copie de FS
Sheets(FS).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = FB
' défusionnage colonne A
With Sheets(FB)
lifin = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
li = lideb
' defusionner colonne agence
For li = lideb To lifin
If .Cells(li, coage).MergeCells Then
.Cells(li, coage).MergeCells = False
Set cel = .Cells(li, coage)
While li < lifin And .Cells(li + 1, coage).Value = ""
li = li + 1
cel.Copy .Cells(li, coage)
Wend
End If
Next li
' defusionner colonne contrats
For li = lideb To lifin
If .Cells(li, cocon).MergeCells Then
.Cells(li, cocon).MergeCells = False
Set cel = .Cells(li, cocon)
While li < lifin And .Cells(li + 1, cocon).Value = ""
li = li + 1
cel.Copy .Cells(li, cocon)
Wend
End If
Next li
End With
End Sub
La macro se charge de la copie de la feuille source (FS)
RQ. B13:B32 n'a pas de contrat et n'est pas fusionnée normal ?
Cdlmnt
Re,
Alors c'est parfait, ca fonctionne parfaitement comme je le souhaitais a l'exception effectivement des contrats qui s'étendent sur les lignes là où n'y en avait pas. C'était bien normal. Du coup j'ai repris ta macro mais je ne vois pas où je dois la modifier pour ce "détail". Donc je suis preneuse de ton aide une fois de plus :-)
merci encore.
a l'exception effectivement des contrats qui s'étendent sur les lignes là où n'y en avait pas.
ça m'apprendra à faire du zèle ;-) du coup une version plus claire
https://www.cjoint.com/c/MFDm75Ihm7B
Cdlmnt
Merci pour votre aide, la solution précédente est adoptée et mise en place :-)