Decaler des groupes de cellules

jeromear

XLDnaute Junior
Bonjour,
Je recherche un moyen d'aligner vers la gauche des groupes de cellules sachant que certaines doivent rester vides. Est-ce possible sans passer par une macro?
 

Pièces jointes

  • DECALER CELLULES.xls
    14 KB · Affichages: 59

hoerwind

XLDnaute Barbatruc
Re : Decaler des groupes de cellules

Bonjour,

Un petit mot d'explication aurait été le bienvenu.

Si j'ai compris :
Ligne 5 : les données de base
Ligne 11 : le résultat souhaité, ce résultat devant rester en ligne 11 et non en ligne 5.

Peux-tu confirmer ?
 

jeromear

XLDnaute Junior
Re : Decaler des groupes de cellules

Bonjour hoerwind
oui je n'ai pas précisé ma recherche
c'est exactement cela que je recherche à faire : obtenir sur la ligne 11 les données de la ligne 5 alignées vers la gauche en respectant les cellules vides.
(Si une macro est necessaire je suis aussi interessé)
Merci pour vos réponses.
 
Dernière édition:

RiquetLan76

XLDnaute Nouveau
Re : Decaler des groupes de cellules

Voici le code des macro à mettre en place
pour copy du table suivant modèle fourni

Esperant avoir été pertinant


Sub CopyDecaler()
'
' Macro pour Copy décaler
'
Dim aAdrCell_Depart(7) As String
Dim aAdrCell_Arrive(7) As String
Dim lnDesti As Integer

' Tableau des adresses de départs

aAdrCell_Depart(1) = "B5:E5"
aAdrCell_Depart(2) = "G5:J5"
aAdrCell_Depart(3) = "L5:O5"
aAdrCell_Depart(4) = "Q5:T5"
aAdrCell_Depart(5) = "V5:Y5"
aAdrCell_Depart(6) = "AA5:AD5"
aAdrCell_Depart(7) = "AF5:AI5"


' Tableau des adresses d'arrivé
aAdrCell_Arrive(1) = "B11:E11"
aAdrCell_Arrive(2) = "G11:J11"
aAdrCell_Arrive(3) = "L11:O11"
aAdrCell_Arrive(4) = "Q11:T11"
aAdrCell_Arrive(5) = "V11:Y11"
aAdrCell_Arrive(6) = "AA11:AD11"
aAdrCell_Arrive(7) = "AF11:AI11"


' Index table de destination
lnDesti = 1


' boucle sur le table de départ
For lnA = 1 To 7
' Controle si une des cellule de la seleciton est rempli
If CtrlContenu(aAdrCell_Depart(lnA)) Then
Range(aAdrCell_Depart(lnA)).Select
Selection.Copy
CopySpecial (aAdrCell_Arrive(lnDesti))
lnDesti = lnDesti + 1
End If
Next




End Sub

'
'
'Copy spéciale sur avec parametre adresse de cellule
'
Sub CopySpecial(tcAdress As String)
Range(tcAdress).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub

'
'
' Controle le contenu de chaque cellule
'
Function CtrlContenu(tcAdresse As String)
Dim lnReturn As Boolean
lnReturn = False
For Each Cell In Range(tcAdresse)
If Cell.Value <> "" Then
lnReturn = True
End If
Next
CtrlContenu = lnReturn
End Function
 

Discussions similaires

Statistiques des forums

Discussions
312 554
Messages
2 089 540
Membres
104 205
dernier inscrit
mehaya63