Microsoft 365 Copier/Coller VBA dans cellules vides

gaelle31

XLDnaute Nouveau
Bonjour,

J'essaie de constituer une macro VBA me permettant de dire : si la cellule en colonne C n'est pas vide, alors les informations contenues dans cette ligne sont copiée dans la première ligne dont la cellule C est vide.
De plus, je souhaiterais qu'il s'agisse d'un copier/coller (pas de suppression de lignes).

J'ai commencé à constituer une macro. Mais, uniquement la dernière donnée remonte et elle efface les précédentes.
De plus, les cellules en colonnes E, H et J contiennent des formules pour lesquelles je ne souhaiterais pas que le copier/coller s'applique.

Merci beaucoup pour votre aide.
 

Pièces jointes

  • TB gestion demandes admin FORUM.xlsm
    34.7 KB · Affichages: 6

vgendron

XLDnaute Barbatruc
Hello
un début de réponse ici
VB:
Sub Copiercoller2()
For i = 22 To 7 Step -1
    If Range("C" & i) <> "" And Range("C" & i - 1) = "" Then
        Range("A" & i).Resize(1, 3).Copy Destination:=Range("A" & i - 1)
        Range("F" & i).Resize(1, 2).Copy Destination:=Range("F" & i - 1)
        Range("H" & i).AutoFill Destination:=Range("H" & i - 1 & ":H" & i)
    End If
Next i
End Sub
 

gaelle31

XLDnaute Nouveau
Hello
un début de réponse ici
VB:
Sub Copiercoller2()
For i = 22 To 7 Step -1
    If Range("C" & i) <> "" And Range("C" & i - 1) = "" Then
        Range("A" & i).Resize(1, 3).Copy Destination:=Range("A" & i - 1)
        Range("F" & i).Resize(1, 2).Copy Destination:=Range("F" & i - 1)
        Range("H" & i).AutoFill Destination:=Range("H" & i - 1 & ":H" & i)
    End If
Next i
End Sub
Merci beaucoup !

Sachant que je souhaiterais que les cellules copier se déplacent vers la première cellule vide. Auriez-vous un élément de réponse me permettant d'effacer les données des cellules copiées s'il-vous-plait ?
 

vgendron

XLDnaute Barbatruc
suffit de rajouter les clear contents qui vont bien,
VB:
Sub Copiercoller2()
For i = 22 To 7 Step -1
    If Range("C" & i) <> "" And Range("C" & i - 1) = "" Then
        Range("A" & i).Resize(1, 3).Copy Destination:=Range("A" & i - 1)
        Range("F" & i).Resize(1, 2).Copy Destination:=Range("F" & i - 1)
        Range("H" & i).AutoFill Destination:=Range("H" & i - 1 & ":H" & i)
        Range("A" & i).Resize(1, 3).ClearContents
        Range("F" & i).Resize(1, 2).ClearContents
    End If
Next i
End Sub
 

gaelle31

XLDnaute Nouveau
J'ai repris votre macro et constitué la VBA suivante :

Sub Copiercoller2()
For i = 22 To 7 Step -1
If Range("C" & i) <> "" And Range("C" & i - 1) = "" Then
Range("A" & i).Resize(1, 3).Copy Destination:=Range("A" & i - 1)
Range("A" & i).Resize(1, 3).ClearContents
Range("F" & i).Resize(1, 2).Copy Destination:=Range("F" & i - 1)
Range("F" & i).Resize(1, 2).ClearContents
Range("H" & i).AutoFill Destination:=Range("H" & i - 1 & ":H" & i)
End If
Next i
End Sub


En revanche,
suffit de rajouter les clear contents qui vont bien,
VB:
Sub Copiercoller2()
For i = 22 To 7 Step -1
    If Range("C" & i) <> "" And Range("C" & i - 1) = "" Then
        Range("A" & i).Resize(1, 3).Copy Destination:=Range("A" & i - 1)
        Range("F" & i).Resize(1, 2).Copy Destination:=Range("F" & i - 1)
        Range("H" & i).AutoFill Destination:=Range("H" & i - 1 & ":H" & i)
        Range("A" & i).Resize(1, 3).ClearContents
        Range("F" & i).Resize(1, 2).ClearContents
    End If
Next i
End Sub
Merci beaucoup !

Pour faire remonter les données de la colonne I, j'ai également rajouté deux données :

Sub Copiercoller2()
For i = 22 To 7 Step -1
If Range("C" & i) <> "" And Range("C" & i - 1) = "" Then
Range("A" & i).Resize(1, 3).Copy Destination:=Range("A" & i - 1)
Range("F" & i).Resize(1, 2).Copy Destination:=Range("F" & i - 1)
Range("I" & i).Resize(1, 1).Copy Destination:=Range("I" & i - 1)
Range("H" & i).AutoFill Destination:=Range("H" & i - 1 & ":H" & i)
Range("A" & i).Resize(1, 3).ClearContents
Range("F" & i).Resize(1, 2).ClearContents
Range("I" & i).Resize(1, 1).ClearContents
End If
Next i
End Sub


Cependant, lorsque je lance la macro, sur mon fichier Des cellules restent vides (lignes 7 et 10) => cf. pièce jointe (après macro lancée...).
Auriez-vous une explication à m'apporter s'il-vous-plait ? Je ne comprends pas d'où peut venir le probleme.

Merci d'avance.
 

Pièces jointes

  • TB gestion demandes admin FORUM.xlsm
    35.2 KB · Affichages: 2

gaelle31

XLDnaute Nouveau
elles ne restent pas vide.. elles sont EFFACEES par la macro..
ce sont les lignes qui ont été copiées collées..
Je m'explique, je suis obligée de lancer plusieurs fois la macro pour faire remonter toutes les données en haut de la sélection. Or, je souhaiterais que toutes mes données se mettent en haut automatiquement, sans avoir besoin de lancer plusieurs fois la macro pour tout faire remonter.
En d'autres termes, je ne souhaite pas qu'il y ait des lignes vides entre chaque données...
 

vgendron

XLDnaute Barbatruc
sinon.. je sens que le besoin ca va etre ca en fait:
VB:
Sub trier()

    Range("B6:J41").Select

    ActiveWorkbook.Worksheets("RECAP").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RECAP").Sort.SortFields.Add Key:=Range("C6:C41"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RECAP").Sort
        .SetRange Range("B6:J41")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub
 

gaelle31

XLDnaute Nouveau
sinon.. je sens que le besoin ca va etre ca en fait:
VB:
Sub trier()

    Range("B6:J41").Select

    ActiveWorkbook.Worksheets("RECAP").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("RECAP").Sort.SortFields.Add Key:=Range("C6:C41"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("RECAP").Sort
        .SetRange Range("B6:J41")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub
Ca marche ! Merci beaucoup :)
 

Discussions similaires

Réponses
15
Affichages
696

Statistiques des forums

Discussions
300 762
Messages
1 987 022
Membres
209 682
dernier inscrit
tecloveur