Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

macro pour inserer une ligne vide a chaque changement de nom + titre

  • Initiateur de la discussion Initiateur de la discussion captaindidi
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

C

captaindidi

Guest
Bonjour,
J'ai plein de données de mon fichier excel.

0 1 A 0 1 2 3 4 5 6 7 8 9
2 3 A 1 2 3 4 5 6 7 8 9 0
4 5 A 2 3 4 5 6 7 8 9 0 1
8 4 B 0 1 2 3 4 5 6 7 8 9
7 F B 1 2 3 4 5 6 7 8 9 0
8 G B 2 3 4 5 6 7 8 9 0 1

J'ai utilisé la macro ci-dessous mais elle ne fonctionne que sur la colonne A.
J'aimerai qu'elle fonction sur la colonne C.
Quelle modification faire ?!


Sub Essai()
Application.ScreenUpdating = False
Dim Ligne As Long
For Ligne = Range("A65536").End(xlUp).Row To 2 Step -1
If Range("A" & Ligne) <> Range("A" & Ligne - 1) Then
Range("A" & Ligne).EntireRow.Insert
End If
Next
Application.ScreenUpdating = False
End Sub


Par ailleurs,
j'aimerai que la ligne inséré au niveau de la colonne A noter en GRAS ROUGE exactement la valeur qui a changé (soit celle qui figure en colonne C)
 
Re : macro pour inserer une ligne vide a chaque changement de nom + titre

Bonjour,

Si la macro fonctionne pour la colonne A et que vous voulez faire la même chose avec la colonne C, changer les termes de la macro du A vers le C

Code:
Sub Essai()
Application.ScreenUpdating = False
Dim Ligne As Long
For Ligne = Range("C65536").End(xlUp).Row To 2 Step -1
If Range("C" & Ligne) <> Range("C" & Ligne - 1) Then
Range("C" & Ligne).EntireRow.Insert
End If
Next
Application.ScreenUpdating = False
End Sub

Autrement le mieux c'est de joindre un fichier exemple (juste quelques lignes) et de montrer le résultat souhaité.
 
Re : macro pour inserer une ligne vide a chaque changement de nom + titre

merci beaucoup
🙂
je joins le fichier pour mieux comprendre la dernière partie
j'aimerai que figure sur la ligne crée dans la 1e cellule de la colonne A (fond jaune gras rouge), la valeur qui a changé
est-ce possible?
 

Pièces jointes

Re : macro pour inserer une ligne vide a chaque changement de nom + titre

Bonjour captaindidi.


C'est plus clair avec un exemple !
Essayez ceci :​
VB:
Sub Essai()
Dim Ligne As Long, Colonne As Variant

    Colonne = "C" ' ou 3, au choix ; fonctionne aussi avec "D" ou 4, "E" ou 5, etc.

    Colonne = Columns(Colonne).Column
    Application.ScreenUpdating = False
    For Ligne = Cells(65536, Colonne).End(xlUp).Row To 2 Step -1
        With Cells(Ligne, Colonne)
            If .Value <> .Offset(-1).Value And Not IsEmpty(.Value) And Not IsEmpty(.Offset(-1).Value) Then
                .EntireRow.Insert
                With .Offset(-1, 1 - Colonne)
                    .Value = .Offset(1, Colonne - 1).Value
                    .Interior.ColorIndex = 6
                    With .Font: .ColorIndex = 3: .Bold = True: End With
                End With
            End If
        End With
    Next
    Application.ScreenUpdating = False
End Sub


Bonne nuit !


ROGER2327
#6914


Mardi 10 Haha 141 (Saint Panmuphle, huissier - fête Suprême Quarte)
24 Vendémiaire An CCXXII, 9,0858h - amaryllis
2013-W42-2T21:48:22Z
 
Re : macro pour inserer une ligne vide a chaque changement de nom + titre

merci beaucoup ... dernière question si je peux me permettre
j'ai ce code créé par l'enregistrement

ActiveCell.FormulaR1C1 = _
"=CONCATENATE(IF(ISBLANK(RC[-2]),0,RC[-2]),"","",IF(ISBLANK(RC[-1]),0,RC[-1]))"
Range("AH2").Select
Selection.AutoFill Destination:=Range("AH2:AH958")
Range("AH2:AH958").Select

dans mon fichier test la dernière ligne fini à 958
mais il peut y avoir plus ou moins d'enregistrement comment pour que ça fonctionne dans tous les cas 🙂 🙂


merci poru ton aide

voici mon code complet
Sub DocPromo()
'
' DocPromo Macro
' Cette macro vise à mettre en forme le DocPromo - V1 15-10-2013
'

'
Columns("J:J").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("I:I").Select
Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("I1").Select
Selection.Copy
Range("K1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(IF(ISBLANK(RC[-2]),0,RC[-2]),"","",IF(ISBLANK(RC[-1]),0,RC[-1]))"
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K958")
Range("K2:K958").Select
Columns("K:K").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("I:J").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("L:L").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("K:K").Select
Selection.TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("K1").Select
Selection.Copy
Range("M1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("M2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(IF(ISBLANK(RC[-2]),0,RC[-2]),"","",IF(ISBLANK(RC[-1]),0,RC[-1]))"
Range("M2").Select
Selection.AutoFill Destination:=Range("M2:M958")
Range("M2:M958").Select
Columns("M:M").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("K:L").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("M:M").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("L:L").Select
Selection.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("L1").Select
Selection.Copy
Range("N1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("N2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(IF(ISBLANK(RC[-2]),0,RC[-2]),"","",IF(ISBLANK(RC[-1]),0,RC[-1]))"
Range("N2").Select
Selection.AutoFill Destination:=Range("N2:N958")
Range("N2:N958").Select
Columns("N:N").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("L:M").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
ActiveWindow.SmallScroll ToRight:=19
Columns("AF:AF").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AE1").Select
Selection.Copy
Range("AG1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("AE:AE").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("AE1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("AG2").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(IF(ISBLANK(RC[-2]),0,RC[-2]),"","",IF(ISBLANK(RC[-1]),0,RC[-1]))"
Range("AG2").Select
Selection.AutoFill Destination:=Range("AG2:AG958")
Range("AG2:AG958").Select
Columns("AG:AG").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("AE:AF").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("AG:AG").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("AF:AF").Select
Selection.TextToColumns Destination:=Range("AF1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("AF1").Select
Selection.Copy
Range("AH1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AH2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(IF(ISBLANK(RC[-2]),0,RC[-2]),"","",IF(ISBLANK(RC[-1]),0,RC[-1]))"
Range("AH2").Select
Selection.AutoFill Destination:=Range("AH2:AH958")
Range("AH2:AH958").Select
Columns("AH:AH").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("AF:AG").Select
Selection.Delete Shift:=xlToLeft

Columns("I:I").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Columns("K:K").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Columns("L:L").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Columns("AE:AE").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True

Columns("AF:AF").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True


Range("M3").Select
Columns("D😀").Select
Selection.Delete Shift:=xlToLeft
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Columns("I:I").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Selection.Cut
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Columns("J:U").Select
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
Selection.Delete Shift:=xlToLeft
Columns("J:K").Select
Selection.Cut
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
Columns("L:M").Select
Selection.Cut
Columns("P😛").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
Columns("P:AE").Select
Selection.Delete Shift:=xlToLeft
Columns("T:AG").Select
Selection.Delete Shift:=xlToLeft
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
Columns("H:H").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("H1").Select
ActiveCell.FormulaR1C1 = "TVA"
Columns("M:M").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("M1").Select
ActiveCell.FormulaR1C1 = "PVP HT"
Range("N1").Select
ActiveCell.FormulaR1C1 = "MA VAL"
Range("O1").Select
ActiveCell.FormulaR1C1 = "MA %"
Range("M2").Select
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Cells.Select
Range("G6").Activate
ActiveWorkbook.Worksheets("Feuil6").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil6").Sort.SortFields.Add Key:=Range("C2:C958") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Feuil6").Sort.SortFields.Add Key:=Range("F2:F958") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ActiveWorkbook.Worksheets("Feuil6").Sort.SortFields.Add Key:=Range("B2:B958") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil6").Sort
.SetRange Range("A1:BU958")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("D😀").Select
Selection.NumberFormat = "0"
Rows("1:1").Select
Selection.Font.Bold = True
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
ActiveCell.FormulaR1C1 = "=IF(R[1]C[-1]=2,2.1,8.5)"
Range("H2").Select
ActiveCell.FormulaR1C1 = "=IF(R[1]C7=2,2.1,8.5)"
Range("H2").Select
Selection.AutoFill Destination:=Range("H2:H957")
Range("H2:H957").Select
Range("A1").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("E1").Select
ActiveCell.FormulaR1C1 = "CODE"
Range("F1").Select
ActiveCell.FormulaR1C1 = "FOURNISSEUR"
Range("I1").Select
ActiveCell.FormulaR1C1 = "PA PROMO HT"
Range("J1").Select
ActiveCell.FormulaR1C1 = "PRIX REVIENT"
Range("K1").Select
ActiveCell.FormulaR1C1 = "C = PHOTO"
Range("L1").Select
ActiveCell.FormulaR1C1 = "PV PROMO TTC"
Range("M1").Select
ActiveCell.FormulaR1C1 = "PVP HT"
Range("N1").Select
ActiveCell.FormulaR1C1 = "MA VAL"
Range("O1").Select
ActiveCell.FormulaR1C1 = "MA %"
Range("P1").Select
ActiveCell.FormulaR1C1 = "PV302"
Range("Q1").Select
ActiveCell.FormulaR1C1 = "PV 306"
Range("M2").Select
ActiveCell.FormulaR1C1 = "=RC12/(1+RC8/100)"
Range("M2").Select
Selection.NumberFormat = "0.00"
Selection.AutoFill Destination:=Range("M2:M959")
Range("M2:M959").Select
Range("N2").Select
ActiveCell.FormulaR1C1 = "=RC13-RC10"
Range("N2").Select
Selection.AutoFill Destination:=Range("N2:N959")
Range("N2:N959").Select
Range("O2").Select
ActiveCell.FormulaR1C1 = "=RC14/RC13"
Range("O2").Select
Selection.NumberFormat = "0.00%"
Selection.AutoFill Destination:=Range("O2:O959")
Range("O2:O959").Select
End Sub
Sub Macro7()
'
Columns("J:J").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("I:I").Select
Selection.TextToColumns Destination:=Range("I1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("I1").Select
Selection.Copy
Range("K1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("K2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(IF(ISBLANK(RC[-2]),0,RC[-2]),"","",IF(ISBLANK(RC[-1]),0,RC[-1]))"
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K958")
Range("K2:K958").Select
Columns("K:K").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("I:J").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("L:L").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("K:K").Select
Selection.TextToColumns Destination:=Range("K1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("K1").Select
Selection.Copy
Range("M1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("M2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(IF(ISBLANK(RC[-2]),0,RC[-2]),"","",IF(ISBLANK(RC[-1]),0,RC[-1]))"
Range("M2").Select
Selection.AutoFill Destination:=Range("M2:M958")
Range("M2:M958").Select
Columns("M:M").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("K:L").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("M:M").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("L:L").Select
Selection.TextToColumns Destination:=Range("L1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("L1").Select
Selection.Copy
Range("N1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("N2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(IF(ISBLANK(RC[-2]),0,RC[-2]),"","",IF(ISBLANK(RC[-1]),0,RC[-1]))"
Range("N2").Select
Selection.AutoFill Destination:=Range("N2:N958")
Range("N2:N958").Select
Columns("N:N").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("L:M").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
ActiveWindow.SmallScroll ToRight:=19
Columns("AF:AF").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AE1").Select
Selection.Copy
Range("AG1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("AE:AE").Select
Application.CutCopyMode = False
Selection.TextToColumns Destination:=Range("AE1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("AG2").Select
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(IF(ISBLANK(RC[-2]),0,RC[-2]),"","",IF(ISBLANK(RC[-1]),0,RC[-1]))"
Range("AG2").Select
Selection.AutoFill Destination:=Range("AG2:AG958")
Range("AG2:AG958").Select
Columns("AG:AG").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("AE:AF").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Columns("AG:AG").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("AF:AF").Select
Selection.TextToColumns Destination:=Range("AF1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Range("AF1").Select
Selection.Copy
Range("AH1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("AH2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = _
"=CONCATENATE(IF(ISBLANK(RC[-2]),0,RC[-2]),"","",IF(ISBLANK(RC[-1]),0,RC[-1]))"
Range("AH2").Select
Selection.AutoFill Destination:=Range("AH2:AH958")
Range("AH2:AH958").Select
Columns("AH:AH").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("AF:AG").Select
Selection.Delete Shift:=xlToLeft

Application.ScreenUpdating = False
Dim Ligne As Long
For Ligne = Range("C65536").End(xlUp).Row To 2 Step -1
If Left(Range("C" & Ligne), 1) <> Left(Range("C" & Ligne - 1), 1) Then
Range("C" & Ligne).EntireRow.Insert
End If
Next
Application.ScreenUpdating = False
End Sub

Sub DocPromo2()
Dim Ligne As Long, Colonne As Variant
Colonne = "C" ' ou 3, au choix ; fonctionne aussi avec "D" ou 4, "E" ou 5, etc.
Colonne = Columns(Colonne).Column
Application.ScreenUpdating = False
For Ligne = Cells(65536, Colonne).End(xlUp).Row To 2 Step -1
With Cells(Ligne, Colonne)
If .Value <> .Offset(-1).Value And Not IsEmpty(.Value) And Not IsEmpty(.Offset(-1).Value) Then
.EntireRow.Insert
With .Offset(-1, 1 - Colonne)
.Value = .Offset(1, Colonne - 1).Value
.Interior.ColorIndex = 6
With .Font: .ColorIndex = 3: .Bold = True: End With
End With
End If
End With
Next
Application.ScreenUpdating = False
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

Réponses
23
Affichages
582
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…