Modifier mise en forme 2 lignes en 1 lignes

lSteph

14/10/2006 à 18:45

Bonjour Gary92,

Suivant ces dispositions:

Sub aaazz()
Dim c As Range, i As Long
Application.ScreenUpdating = False
For Each c In [f1:I1499].Cells
c = c.Offset(1, -5)
Next
Application.Wait (Now + TimeValue("0:00:01"))
For i = 1500 To 2 Step -2
Rows(i).Delete
Next
End Sub

'Cordialement.

- -
lSteph

Gary92 a couché sur son écran :

--
- -

lSteph

JB

14/10/2006 à 18:50

Bonjour,

[A1].Select ' début de la liste
Do While ActiveCell <> ""
ActiveCell.Offset(1, 0).Resize(1, 4).Copy ActiveCell.Offset(0, 5)
ActiveCell.Offset(1, 0).EntireRow.Delete
ActiveCell.Offset(1, 0).Select
Loop

Cordialement JB

Michel Gaboly

14/10/2006 à 18:51

Bonsoir,

Fichier exemple : http://cjoint.com/?kosXU4mc62

Avec le premier NOM en cellule A2 :

Private Sub MiseEnForme()
Dim NbLignes As Integer, Ref As Range, i As Integer
Set Ref = Range("A2")
NbLignes = Ref.CurrentRegion.Rows.Count / 2
With Ref
For i = 0 To NbLignes
.Offset(i, 0) = .Offset(2 * i, 0)
.Offset(i, 1) = .Offset(2 * i, 1)
.Offset(i, 2) = .Offset(2 * i, 2)
.Offset(i, 3) = .Offset(2 * i, 3)
.Offset(i, 4) = .Offset(2 * i, 4)
.Offset(i, 5) = .Offset(2 * i + 1, 0)
.Offset(i, 6) = .Offset(2 * i + 1, 1)
.Offset(i, 7) = .Offset(2 * i + 1, 2)
.Offset(i, 8) = .Offset(2 * i + 1, 3)
Next
Range(.Offset(i - 1, 0), .Offset(2 * i - 3, 4)).ClearContent s
End With
ActiveSheet.Shapes("BMiseEnForme").Visible = False
ActiveSheet.Shapes("BRAZ").Visible = True
End Sub

Set Ref = Range("A2")

à adapter le cas échéant si le premier nom est une cellule autre qu e A2, définit une cellule qui sert de référence.

NbLignes = Ref.CurrentRegion.Rows.Count / 2

Détermine le nombre de personnes à traiter. Même s'il y a une ligne de titre, ce qui donne un total impair, ce n'est pas
grave, car NBLignes est défini comme Integer, et le résultat est arro ndi.

Ensuite on crée une boucle avec un compteur, "i", démarrant à 0

.Offset(i, 0) = .Offset(2 * i, 0)

inscrit dans la même colonne que Réf, i lignes + bas ce qui est dans la même colonne 2 fois i + bas :

Avec i = 0, on reprend le contenu de la cellule (2 * i égale 0 aussi)
Avec i = 1, on récupère ce qui 2 lignes + bas
Avec i = 2, on récupère ce qui est 4 lignes + bas
...

Pareil pour les colonnes B à E

Pour les colonnes F à I on introduit un décalage d'une ligne supplé mentaire et de 5 colonnes de moins :

.Offset(i, 5) = .Offset(2 * i + 1, 0)

Une fois la boucle terminée, on efface les données rédiduelles des 5 premières colonnes, devenues inutiles car réparties
dans les lignes préédentes, lors du report.

Si le traitement est trop long, rajouter au début la ligne

Application.ScreenUpdating = False

A ta disposition pour + d'explications.

--
Cordialement,

Michel Gaboly
www.gaboly.com

Bonsoir,

Fichier exemple : http://cjoint.com/?kosXU4mc62

Avec le premier NOM en cellule A2 :

Private Sub MiseEnForme()
Dim NbLignes As Integer, Ref As Range, i As Integer
Set Ref = Range("A2")
NbLignes = Ref.CurrentRegion.Rows.Count / 2
With Ref
For i = 0 To NbLignes
.Offset(i, 0) = .Offset(2 * i, 0)
.Offset(i, 1) = .Offset(2 * i, 1)
.Offset(i, 2) = .Offset(2 * i, 2)
.Offset(i, 3) = .Offset(2 * i, 3)
.Offset(i, 4) = .Offset(2 * i, 4)
.Offset(i, 5) = .Offset(2 * i + 1, 0)
.Offset(i, 6) = .Offset(2 * i + 1, 1)
.Offset(i, 7) = .Offset(2 * i + 1, 2)
.Offset(i, 8) = .Offset(2 * i + 1, 3)
Next
Range(.Offset(i - 1, 0), .Offset(2 * i - 3, 4)).ClearContent s
End With
ActiveSheet.Shapes("BMiseEnForme").Visible = False
ActiveSheet.Shapes("BRAZ").Visible = True
End Sub

Set Ref = Range("A2")

à adapter le cas échéant si le premier nom est une cellule autre qu e A2, définit une cellule qui sert de référence.

NbLignes = Ref.CurrentRegion.Rows.Count / 2

Détermine le nombre de personnes à traiter. Même s'il y a une ligne de titre, ce qui donne un total impair, ce n'est pas
grave, car NBLignes est défini comme Integer, et le résultat est arro ndi.

Ensuite on crée une boucle avec un compteur, "i", démarrant à 0

.Offset(i, 0) = .Offset(2 * i, 0)

inscrit dans la même colonne que Réf, i lignes + bas ce qui est dans la même colonne 2 fois i + bas :

Avec i = 0, on reprend le contenu de la cellule (2 * i égale 0 aussi)
Avec i = 1, on récupère ce qui 2 lignes + bas
Avec i = 2, on récupère ce qui est 4 lignes + bas
...

Pareil pour les colonnes B à E

Pour les colonnes F à I on introduit un décalage d'une ligne supplé mentaire et de 5 colonnes de moins :

.Offset(i, 5) = .Offset(2 * i + 1, 0)

Une fois la boucle terminée, on efface les données rédiduelles des 5 premières colonnes, devenues inutiles car réparties
dans les lignes préédentes, lors du report.

Si le traitement est trop long, rajouter au début la ligne

Application.ScreenUpdating = False

A ta disposition pour + d'explications.

--
Cordialement,

Michel Gaboly
www.gaboly.com

Vous avez filtré cet utilisateur ! Consultez son message

Bonsoir,

Fichier exemple : http://cjoint.com/?kosXU4mc62

Avec le premier NOM en cellule A2 :

Private Sub MiseEnForme()
Dim NbLignes As Integer, Ref As Range, i As Integer
Set Ref = Range("A2")
NbLignes = Ref.CurrentRegion.Rows.Count / 2
With Ref
For i = 0 To NbLignes
.Offset(i, 0) = .Offset(2 * i, 0)
.Offset(i, 1) = .Offset(2 * i, 1)
.Offset(i, 2) = .Offset(2 * i, 2)
.Offset(i, 3) = .Offset(2 * i, 3)
.Offset(i, 4) = .Offset(2 * i, 4)
.Offset(i, 5) = .Offset(2 * i + 1, 0)
.Offset(i, 6) = .Offset(2 * i + 1, 1)
.Offset(i, 7) = .Offset(2 * i + 1, 2)
.Offset(i, 8) = .Offset(2 * i + 1, 3)
Next
Range(.Offset(i - 1, 0), .Offset(2 * i - 3, 4)).ClearContent s
End With
ActiveSheet.Shapes("BMiseEnForme").Visible = False
ActiveSheet.Shapes("BRAZ").Visible = True
End Sub

Set Ref = Range("A2")

à adapter le cas échéant si le premier nom est une cellule autre qu e A2, définit une cellule qui sert de référence.

NbLignes = Ref.CurrentRegion.Rows.Count / 2

Détermine le nombre de personnes à traiter. Même s'il y a une ligne de titre, ce qui donne un total impair, ce n'est pas
grave, car NBLignes est défini comme Integer, et le résultat est arro ndi.

Ensuite on crée une boucle avec un compteur, "i", démarrant à 0

.Offset(i, 0) = .Offset(2 * i, 0)

inscrit dans la même colonne que Réf, i lignes + bas ce qui est dans la même colonne 2 fois i + bas :

Avec i = 0, on reprend le contenu de la cellule (2 * i égale 0 aussi)
Avec i = 1, on récupère ce qui 2 lignes + bas
Avec i = 2, on récupère ce qui est 4 lignes + bas
...

Pareil pour les colonnes B à E

Pour les colonnes F à I on introduit un décalage d'une ligne supplé mentaire et de 5 colonnes de moins :

.Offset(i, 5) = .Offset(2 * i + 1, 0)

Une fois la boucle terminée, on efface les données rédiduelles des 5 premières colonnes, devenues inutiles car réparties
dans les lignes préédentes, lors du report.

Si le traitement est trop long, rajouter au début la ligne

Application.ScreenUpdating = False

A ta disposition pour + d'explications.

--
Cordialement,

Michel Gaboly
www.gaboly.com

Jacky

14/10/2006 à 18:53

Bonsoir,
En supposant que les données soient en colonne A:E (nom prenom...) et A:D
(bureau service....) et que les donnes comment en ligne 2
Ceci:
'-------------
Sub jj()
Application.ScreenUpdating = False
For i = Range("a65536").End(xlUp).Row To 2 Step -2
Range("a" & i & ":d" & i).Copy
Range("f" & i - 1).PasteSpecial Paste:=xlPasteValues
Rows(i).Delete
Next
End Sub
'----------
--
Salutations
JJ

"Gary92" a écrit dans le message de news:

Gary92

14/10/2006 à 18:57

Merci beaucoup à vous trois, je vais m'y atteler.
Bon dimanche
Gérard.

"Gary92" a écrit dans le message de news:

lSteph

14/10/2006 à 19:01

..ou plus simplement:

Sub aaazz()
Dim i As Long
Application.ScreenUpdating = False
[a2:e1500].Copy Destination:=[f1]
For i = 1500 To 2 Step -2
Rows(i).Delete
Next
End Sub

'lSteph

--
- -

lSteph

Gary92

14/10/2006 à 19:31

Géant !! Je viens d'appliquer celle-ci et celà marche impec.
Un grand merci '1Steph et aux autres aussi, bien sûr.

"lSteph" a écrit dans le message de news:

JB

15/10/2006 à 13:35

Bonjour,

Sans boucle de suppression (champ commence en A1):

[A2].Resize([A65000].End(xlUp).Row, 5).Copy [F1]
[E:E].SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Cordialement JB

Modifier mise en forme 2 lignes en 1 lignes

8 réponses

Veuillez sélectionner un problème