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

C

captaindidi

XLDnaute Nouveau
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)
 
Trier par date Trier par votes
piga25

piga25

XLDnaute Barbatruc
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é.
 
Vote positif 0 Vote négatif
C

captaindidi

XLDnaute Nouveau
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

  • extrait.xlsx
    8.4 KB · Affichages: 55
  • extrait.xlsx
    8.4 KB · Affichages: 69
  • extrait.xlsx
    8.4 KB · Affichages: 59
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
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
 
Vote positif 0 Vote négatif
C

captaindidi

XLDnaute Nouveau
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: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: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: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
 
Vote positif 0 Vote négatif

Discussions similaires

N
  • Question
XL 2016 additionner des valeurs suite à une recherche de valeur cible
Réponses
3
Affichages
210
Annach
A
PORCHER
  • Question
Microsoft 365 L'indice n'appartient pas à la sélection
Réponses
8
Affichages
361
TooFatBoy
TooFatBoy
U
  • Résolu(e)
Autres Centrer ou Annuler Centrer
Réponses
12
Affichages
276
un internaute
U
C
  • Question
XL 2013 Userform ne fonctionne pas s'il manque des Numéros de liste
Réponses
9
Affichages
360
candido57
C
K
  • Résolu(e)
Microsoft 365 Création d'une occurrence avec lignes vides
Réponses
7
Affichages
429
kawi99
K
Y
  • Question
Power Query Décompte simple de ligne
Réponses
2
Affichages
193
Amilo
A
M
  • Question
Microsoft 365 Formule avec OU ?
Réponses
5
Affichages
264
moanin
M
C
  • Résolu(e)
XL 2013 Insérer des lignes
Réponses
5
Affichages
365
candido57
C
T
  • Question
XL 2019 tableau championnat interbanques
Réponses
1
Affichages
370
fanfan38
fanfan38
G
  • Question
Microsoft 365 Incompatibilité de type - Array
Réponses
2
Affichages
252
guiyom
G

Membres actuellement en ligne

11 membres et 120 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 448
Messages
2 088 500
Membres
103 871
dernier inscrit
julienleburton