jeromear
XLDnaute Junior
Bonjour à tous les passionnés d'Excel.
Sur une ligne, je cherchais à effectuer un alignement à gauche de 7 blocs composés de 4 cellules, pleines ou vides .
Regarde la pièce jointe DECALER CELLULES 1.xls
RiquetLan76 m'a proposé une macro qui fonctionne bien :
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
Aujourd'hui en avançant dans mon programme je dois réaliser ce même alignement avec en plus :
- un alignement gauche à l'intérieur de chaque bloc de 4 cellules
- la répétition de cette fonction sur une feuille de 12 lignes
Regarde la pièce jointe DECALER CELLULES 2.xls
Est-ce que quelqu'un peut m'aider et merci d'avance (je reste connecté derrière mon écran quelques jours car en convalescence).
Jérome.
Sur une ligne, je cherchais à effectuer un alignement à gauche de 7 blocs composés de 4 cellules, pleines ou vides .
Regarde la pièce jointe DECALER CELLULES 1.xls
RiquetLan76 m'a proposé une macro qui fonctionne bien :
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
Aujourd'hui en avançant dans mon programme je dois réaliser ce même alignement avec en plus :
- un alignement gauche à l'intérieur de chaque bloc de 4 cellules
- la répétition de cette fonction sur une feuille de 12 lignes
Regarde la pièce jointe DECALER CELLULES 2.xls
Est-ce que quelqu'un peut m'aider et merci d'avance (je reste connecté derrière mon écran quelques jours car en convalescence).
Jérome.