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

Z

zizou026

XLDnaute Nouveau
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
 
Solution
job75
Bonjour zizou026, le forum,

Dans ce fichier (3) j'ai supprimé la RAZ et ajouté des tests pour le traitement du tableau, c'est plus rapide :
Code: 
Sub Insertion()
'se lance par Ctrl+M
Dim ncol%, tablo, resu(), i&, n&, test As Boolean, j%
Application.ScreenUpdating = False
With ActiveSheet
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    .Cells.FormatConditions.Delete 'supprime toutes les MFC
    '---tableau des résultats---
    With .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, 1) <> "" And tablo(i - 1, 1) <> "" Then 'les 2 lignes sont...
Trier par date Trier par votes
Z

zizou026

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

Staple1600

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

zizou026

XLDnaute Nouveau
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
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
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)
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

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

zizou026

XLDnaute Nouveau
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+
Cliquez pour agrandir...
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
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Classement(1).xlsm
    51.6 KB · Affichages: 1
Vote positif 0 Vote négatif
job75

job75

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

Pièces jointes

  • Classement(2).xlsm
    51.7 KB · Affichages: 8
Vote positif 0 Vote négatif
Z

zizou026

XLDnaute Nouveau
C'est exactement ce qu'il me faut merci beaucoup :D .

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

Discussions similaires

F
  • Résolu(e)
Microsoft 365 VBA pour copier et insérer une ligne en dessous
Réponses
5
Affichages
197
Phil69970
Phil69970
halecs93
  • Question
XL 2016 Masquer et afficher lignes
Réponses
3
Affichages
129
gbinforme
G
Y
  • Résolu(e)
XL 2013 Surligner une ligne si curseur sur la ligne et dans une zone définie
Réponses
2
Affichages
180
Yvan1
Y
E
  • Résolu(e)
Microsoft 365 Peut-on insérer un code EntireRow.AutoFit dans une Function?
Réponses
8
Affichages
441
Englobe
E
D
  • Question
Autres boucle copier ligne
Réponses
2
Affichages
327
dadaze
D
S
  • Résolu(e)
Microsoft 365 Récupérer la date dans un calendrier
Réponses
2
Affichages
156
sebastien176
S
B
  • Question
XL 2013 Comment trier les nom des feuilles et fusionner leur tableaux dans une une autre feuille ?
Réponses
10
Affichages
282
Compte Supprimé 979
C
A
  • Question
Insérer un copier / coller
Réponses
0
Affichages
206
aziz
A
E
  • Résolu(e)
Microsoft 365 Boucle sur lignes <>0
Réponses
2
Affichages
176
eric72
E
M
  • Question
Microsoft 365 cellules vides et boite de dialogue
Réponses
2
Affichages
184
michel.dupont
M

Membres actuellement en ligne

8 membres et 117 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 500
Messages
2 089 005
Membres
104 003
dernier inscrit
adyady__