XL 2010 Insérer une une ligne et copier la cellule d'en dessous

zizou026 · 2 Janvier 2021

Bonjour,
Une excellente année à toutes et à tous.
J'ai trouvé ce formule :
Sub complèter()
Sheets("toto").Select
x = [B65536].End(3).Row
For Each C In Range("A1:A" & x).SpecialCells(xlCellTypeBlanks)
C.Value = Range(C.Address).End(3).Value
Next
End Sub
Comment faire pour ça insère une ligne et copie la cellule d'en dessous?
Par avance, je vous remercie.
Cordialement,
zizou

Staple1600 · 2 Janvier 2021

Bonjour

Est-ce ceci que tu veux faire?

VB:

Sub Macro4()
Dim r As Range
Application.ScreenUpdating = False
Set r = Columns("A:A").SpecialCells(xlCellTypeBlanks)
r.FormulaR1C1 = "=R[-1]C"
Columns("A:A") = Columns("A:A").Value
End Sub

zizou026 · 2 Janvier 2021

Bonsoir, je te remercie pour ta réponse et te souhaite une excellente année.

J'ai testé la formule elle ne recopie pas la cellule d'en dessus et n'insère pas de ligne.

Si possible, je souhaite que la ligne insérée soit en couleur grise, j'ai plusieurs onglets serait il possible de les associés?

Merci beaucoup et souhaite une bonne soirée.

Cordialement,

zizou

Staple1600 · 3 Janvier 2021

Bonjour le fil

=>zizou026
Si tu joignais un fichier exemple (anonymisé) cela nous aiderait grandement pour faire nos tests avant de te proposer une solution.
(avec classeur avec 3 ou onglets à traiter suffira)
Et un trentaine de lignes par onglet.

zizou026 · 3 Janvier 2021

Staple1600 à dit:
Bonjour

Est-ce ceci que tu veux faire?

VB:

Sub Macro4() Dim r As Range Application.ScreenUpdating = False Set r = Columns("A:A").SpecialCells(xlCellTypeBlanks) r.FormulaR1C1 = "=R[-1]C" Columns("A:A") = Columns("A:A").Value End Sub

Bonjour Staple1600,

j'ai réussi à faire ça :

Sub Macro4()
Sheets("Toto").Select
Dim r As Range
Application.ScreenUpdating = False
Set r = Columns("A:A").SpecialCells(xlCellTypeBlanks)
r.FormulaR1C1 = "=R[+1]C"
Application.ScreenUpdating = False
Set r = Columns("C:C").SpecialCells(xlCellTypeBlanks)
r.FormulaR1C1 = "=R[+1]C"
End Sub

Ce formule répond à peut prêt à mes attentes (il reprend bien les données d'en dessous) mais il n'insère pas de ligne et ne le met pas gris.

Je souhaite que deuxième donnée s'affiche dans la colonne B. Et, comment faire pour l'intégrer dans plusieurs onglets?

Par avance, je te remercie de ton aide et te souhaite un bon dimanche.

Cordialement,

zizou

Staple1600 · 3 Janvier 2021

Re

Comme je le disais dans le message#4
Tu peux joindre un fichier Excel
(pour que l'on ait un exemple sur lequel faire nos tests)
Tu as juste à cliquer sur: Joindre un fichier

zizou026 · 3 Janvier 2021

Staple1600 à dit:
Bonjour le fil

=>zizou026
Si tu joignais un fichier exemple (anonymisé) cela nous aiderait grandement pour faire nos tests avant de te proposer une solution.
(avec classeur avec 3 ou onglets à traiter suffira)
Et un trentaine de lignes par onglet.

zizou026 · 3 Janvier 2021

Merci

Staple1600 · 3 Janvier 2021

Re

Ce que qu'on peut lire dans ta PJ n'a plus rien à voir avec le titre de ta question
Insérer une une ligne et copier la cellule d'en dessous
Tu parles maintenant de deux lignes.
Tu aurais du mettre ta PJ dès le départ, car j'étais arrivé à ce code
(qui désormais ne sert plus à grand chose)

VB:

Sub test()
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In Worksheets
If Application.CountA(ws.Columns(2)) > 0 Then
insérer ws, 2
End If
Next
End Sub
Private Sub insérer(F As Worksheet, col&)
Dim DLig&, i&, r As Range
DLig = F.Cells(Rows.Count, col).End(xlUp).Row
For i = DLig To 2 Step -1
If F.Cells(i, col).Value <> F.Cells(i - 1, col).Value Then F.Rows(i).Insert
Next i
Set r = F.Cells(1, col).Resize(F.Cells(Rows.Count, col).End(3).Row).SpecialCells(4)
Set r = Union(r, F.Cells(Rows.Count, col).End(3)(2))
r = "=R[-1]C": r.Interior.ColorIndex = 15
F.Columns(col) = F.Columns(col).Value
Set r = Nothing
End Sub

EDITION: Bonjour job75 (et meilleurs voeux pour 2021)

job75 · 3 Janvier 2021

Bonjour zizou026, JM,

Le tableau en exemple est incomplet, j'ai 2 questions :

- s'il y a une valeur en D23 faut-il la copier en C22 ? Idem pour E23, F23, G23...

- quel est le nombre maximum de lignes que peut avoir le tableau ? Plusieurs centaines ? Plusieurs milliers ?

A+

zizou026 · 3 Janvier 2021

job75 à dit:
Bonjour zizou026, JM,

Le tableau en exemple est incomplet, j'ai 2 questions :

- s'il y a une valeur en D23 faut-il la copier en C22 ? Idem pour E23, F23, G23...

- quel est le nombre maximum de lignes que peut avoir le tableau ? Plusieurs centaines ? Plusieurs milliers ?

A+

Bonjour job75,

Il y a des données de A2 jusqu'à X (je peux avoir des données > à 500 000 lignes.

Un fois l'insertion des lignes reprendre la donnée de la cellule inférieur et celle 3ème cellule à côté de la colonne A.

Merci encore...

Cordialement,

zizou026

job75 · 3 Janvier 2021

Merci JM, je te souhaite à toi aussi une bonne et heureuse année.

Pour notre problème avec 500 000 lignes il faut utiliser des tableaux VBA :

VB:

Sub Insertion()
'se lance par Ctrl+M
Dim ncol%, tablo, resu(), i&, n&, j%
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
'---RAZ pour le cas où la macro a déjà été exécutée---
ActiveSheet.Cells.FormatConditions.Delete 'supprime les MFC
With ActiveSheet.UsedRange
    .Columns(1).EntireColumn.Insert 'insère une colonne auxiliaire
    .Columns(0) = "=1/OR(RC[1]="""",RC[2]=R[1]C[3])"
    .Columns(0) = .Columns(0).Value 'supprime les formules
    .EntireRow.Sort .Columns(0), xlDescending, Header:=xlYes 'tri pour regrouper et accélérer
    .Columns(0).SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete 'supprime les lignes
    .Columns(0).EntireColumn.Delete
End With
'---traitement---
With ActiveSheet.UsedRange
    ncol = .Columns.Count
    If ncol < 3 Then ncol = 3
    tablo = .Resize(, ncol) 'matrice, plus rapide
    ReDim resu(1 To Rows.Count, 1 To ncol)
    For i = 2 To UBound(tablo)
        If tablo(i, 2) = tablo(i - 1, 2) Then
            n = n + 1
        Else
            n = n + 3
            resu(n - 1, 1) = tablo(i, 1)
            resu(n - 1, 2) = tablo(i, 3)
        End If
        For j = 1 To ncol
            resu(n, j) = tablo(i, j)
    Next j, i
    .Offset(1).Resize(n) = resu 'restitution
End With
'---mise en forme conditionnelle (MFC)---
With ActiveSheet.UsedRange.Offset(1)
    .FormatConditions.Add xlExpression, Formula1:="=" & .Cells(0, 1).Address(0, 1) & "="""""
    .FormatConditions(1).Font.Bold = True 'gras
    .FormatConditions(1).Interior.ColorIndex = 48 'gris foncé
End With
End Sub

Touches Ctrl+M pour lancer la macro sur la feuille active du fichier joint.

A+

job75 · 3 Janvier 2021

Dans ce fichier (2) j'ai modifié le critère pour la RAZ, c'est mieux je pense :

VB:

Sub Insertion()
'se lance par Ctrl+M
Dim ncol%, tablo, resu(), i&, n&, j%
Application.ScreenUpdating = False
On Error Resume Next 'si aucune SpecialCell
'---RAZ pour le cas où la macro a déjà été exécutée---
ActiveSheet.Cells.FormatConditions.Delete 'supprime les MFC
With ActiveSheet.UsedRange
    .Columns(1).EntireColumn.Insert 'insère une colonne auxiliaire
    .Columns(0).Offset(1) = "=1/OR(RC[1]="""",R[-1]C[1]="""")"
    .Columns(0).Offset(1) = .Columns(0).Offset(1).Value 'supprime les formules
    .EntireRow.Sort .Columns(0), xlDescending, Header:=xlYes 'tri pour regrouper et accélérer
    .Columns(0).SpecialCells(xlCellTypeConstants, 1).EntireRow.Delete 'supprime les lignes
    .Columns(0).EntireColumn.Delete
End With
'---traitement---
With ActiveSheet.UsedRange
    ncol = .Columns.Count
    If ncol < 3 Then ncol = 3
    tablo = .Resize(, ncol) 'matrice, plus rapide
    ReDim resu(1 To Rows.Count, 1 To ncol)
    For i = 2 To UBound(tablo)
        If tablo(i, 2) = tablo(i - 1, 2) Then
            n = n + 1
        Else
            n = n + 3
            resu(n - 1, 1) = tablo(i, 1)
            resu(n - 1, 2) = tablo(i, 3)
        End If
        For j = 1 To ncol
            resu(n, j) = tablo(i, j)
    Next j, i
    .Offset(1).Resize(n) = resu 'restitution
End With
'---mise en forme conditionnelle (MFC)---
With ActiveSheet.UsedRange.Offset(1)
    .FormatConditions.Add xlExpression, Formula1:="=" & .Cells(0, 1).Address(0, 1) & "="""""
    .FormatConditions(1).Font.Bold = True 'gras
    .FormatConditions(1).Interior.ColorIndex = 48 'gris foncé
End With
End Sub

zizou026 · 3 Janvier 2021

C'est exactement ce qu'il me faut merci beaucoup

.

Question : comment faire pour les autres onglets? Dans ta formule, j'ai essayé de rentrer le nom de la feuille ça ne le prend pas en compte. À quel moment je peux inclure le nom de la feuille?

Merci beaucoup job75

job75 · 3 Janvier 2021

Il n'y a pas à se préoccuper du nom de la feuille.

Comme déjà dit c'est la feuille active qui est traitée quand on appuie sur les touches Ctrl+M.

XL 2010 Insérer une une ligne et copier la cellule d'en dessous

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Nouveau

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Barbatruc

Discussions similaires

Partager cette page

Statistiques des forums