Remonter une plage de cellules d'une colonne

Bonjour à tous et merci de toutes vos coopérations.

C'est un petit problème étrange que je vous soumet qui se concrétise dans le fichier Excel joint:

Dans la plage de cellules d'une colonne, il y a des cellules vides. Je veux faire remonter toutes les cellules renseignées de cette colonne et, dans une configuration d'essai, un débogage de la macro se produit. Toutes les données des colonnes sont des nombres et au format identique.

Configuration 1 de l'application:

Les colonnes vertes de L1 à M20 sont copiées et collées en A1/ B20

En lançant la macro, les cellules renseignées de la colonne B remontent très bien Ligne 1 à 7

Configuration 2 de l'application:

Les colonnes oranges de G1 à H20 sont copiées et collées en A1/ B20

En lançant la macro, les cellules renseignées de la colonne B ne remontent pas (débogage) Ligne 1 à 7

Toutes les cellules des différentes colonnes sont testées respectivement exactes entre les 2 configurations

Il doit il y avoir pourtant une différence entre cellules des colonnes G/H et L/M copiées respectivement dans chacun des 2 essais en A/B et je ne vois pas laquelle.

Merci à ceux qui pourront me renseigner et résoudre cette petite énigme afin que je puisse l'utiliser dans mon fichier principal.

Bonne continuation à tous.

Le programme de la macro,

Macro commune aux 2 essais

Sub facvides()
Dim rng As Range, Cell As Range
With ThisWorkbook.Sheets("Feuil1")
Set rng = Range("A1:A20")
For Each Cell In rng
If Cell.Value = "" Then
[B1:B20].SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End If
Next
End With
End Sub

Bonjour Matysek35, le forum,

Sélectionne "A1:B20", regarde sur la barre d'état à droite. L'on y voit : Nb(non vides) : 14

Sélectionne "G1:H20", regarde sur la barre d'état à droite. L'on y voit : Nb(non vides) : 40

Tout simplement

Bastr

Bonjour Bastr et merci de cette belle réactivité

Les cellules non renseignées des colonnes G/H ouV/W ne sont pas vie magré une vérification de l'exactitude.

Dans la macro principale de la feuille, juste avant d'effectuer cette macro, il y a ce qui suit:

If Range("C1").Value <> "" And Range("D1").Value <> 0 Then ‘D1 indique que la plage de formules à copier n'est pas vide

Range("K1:K20").Copy 'Résultat d'une copie de cellules avec formules à un autre endroit

End If

If G1:H20 videsThen Range("G1:H20").PasteSpecial xlPasteValues 'Copie des données précédentes seules

If f G1:H20 non videspartout, Then ' si les données sont bien collées

Module4.facvides ' Appel du sub pour remonter les cellules

Le problème est donc le collage de cellules vides et je ne vois pas ce qu'Excel y met très exactement qui fait qu'elles ne le sont pas finalement.

Finament que faut-il faire pour s'assurer qu'elles soient vidées de quelque chose que je n'arrive pas à déterminer.

Une intervention humaine pour le faire manuellement est exclue.

A bientôt peut-être

Bonjour Matysek35, le forum,

Après avoir collé la plage :

        Set rng = Range("A1:B20") ' < plage à adapter
        For Each Cell In rng
            If Len(Cell.Value) = 0 Then Cell.ClearContents
        Next

Ce qui pourrait donner :

Sub facvides()

    Dim rng As Range, Cell As Range
    With ThisWorkbook.Sheets("Feuil1")
        Set rng = Range("A1:B20")     ' < attention A et B

        For Each Cell In rng
            If Len(Cell.Value) = 0 Then Cell.ClearContents
        Next Cell

        Set rng = Nothing
        Set rng = Range("A1:A20")    ' < plage normale

        For Each Cell In rng
            If Cell.Value = "" Then
                [B1:B20].SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
            End If
        Next
    End With
End Sub

Bastr

Bonjour/Bonsoir Bastr

Un grand merci de ton dernier message, Il fonctionne parfaitement dans l'exemple publié et je ferais les adaptaions dans mon fichier principal prochainement.

Su ry l'as constaté, les valeurs ne sont pas le fruit du hasrad mais1,2,3,4 5 toutes les combinaisons de dizaine12,13,14,... 45, centaine à partir de ces 5 chiffres.

J'ai, dans Excel complété ma colonne initiale de valeurs afin que la macro puisse bien lire dès la 1ère ligne: 1 ou 2 ou 5 au départ et arrète la lecture au nombre maxi.

En conclusion je dois écrire x fois la 2ème partie de macro qui va remonter les cellules suivant la combinaison de chiffres établie en unité, dizaine...

Dans tous les cas, un grand bravo à toi et merci de ta précieuse et rapide aide.

Bonne continuation dans tes activités

Matysek35

Bonjour Matysek35, le forum,

Bien heureux que ce bout de code ait pu résoudre ton souci.

Bastr

Bonjour Bastr avec mes excuses pour te solliciter encore une fois.

Dans lapplication de ton bout de code, comme tu le dit, c'est tout bon et je te remets le code concerné si ce n'est que j'ai séparé la procédure de vider les cellules qui n'ont rien après collage en utilisant les varaibles rngv et cell eu lieu de rng seul auparavant:

Sub ViderRemonter()

Dim rng As Range, rngx As Range, Cell As Range, Cellx As Range
'Colonnes A et B (valeurs collées)

With ThisWorkbook.Sheets("Feuil1")
Set rngx = Nothing
Set rngx = Range("A1:B20") 'Colonnes A et B testées
For Each Cellx In rngx
If Len(Cellx.Value) = 0 Then Cellx.ClearContents 'Colonnes A et B vidées si non renseignées
Next Cellx
End With

With ThisWorkbook.Sheets("Feuil1")
Set rng = Nothing
Set rng = Range("B1:B30") 'Colonne B testée

For Each Cell In rng
If Cell.Value = "" Then 'Colonne B remontée si ligne non renseignée
[B1:B20].SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
End If
Next
End With
End Sub

Dans mon application, par contre, le vidage ne se fait pas.

Il y a de petites différences entre les 2 (Nom feuille, cellules et Ce sub est placé dans le Module 4, rng1 et Cellx sont les variables pour le vidage, rng et cell pour la remontée.

Voilà les extraits concernés de mon application:

Sub ViderRemonter() 'dans le Module4
Dim rng As Range, rngx As Range, Cell As Range, Cellx As Range
'Colonnes DA et DB (valeurs collées)
With ThisWorkbook.Sheets("Contact")
Set rngx = Nothing
Set rngx = Range("DA1:DB30").Value 'Colonnes DA et DB testées Erreur 424 Objet requis
For Each Cellx In rngx
If Len(Cellx.Value) = 0 Then Cellx.ClearContents 'Colonnes A et B vidées si non renseignées
Next Cellx
End With

'Remonter (DA20= Dernière ligne contenant la valeur max 135 dans le cas de l'exemple

With ThisWorkbook.Sheets("Contact")

If Range("DA20").Value <> "" And Range("DA20").Value = Range("CX36").Value Then
For Each Cell In rng
If Cell.Value = "" Then
[DB1:DB20].SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp ' Lignes 1 à 20 (lignes 20maxi )
End If
Next
End If

End With

End sub

Bonne journée

Cordialement