passage a une autre ligne

[softimen]

Bonjour tout le monde,

Je suis débutante en vba , et j'ai besoin de votre aide s'il vous plait .

J'ai cette macro qui permet de grouper les différents données pour deux mémés cellules qui se répètent sur plusieurs lignes.

Mon problème c'est que il regroupe les données seulement pour 2 lignes mais pas plus , je voudrai qui'il regroupe les données sur une mémé ligne qui ont les mémés cellule B et C qui se répètent sur plusieurs lignes .

J'arrive pas a trouver le pb dans mon code qui execute seulement pour 2 lignes .

Merci d'avance.





'code VBA


Function inserer(FL2 As Worksheet, lig As Integer, col As Integer)



If (FL2.Cells(lig, 20) <> "") Then
FL2.Cells(col, 19) = FL2.Cells(lig, 19)
FL2.Cells(col, 20) = FL2.Cells(lig, 20)
FL2.Cells(col, 21) = FL2.Cells(lig, 21)
FL2.Cells(col, 22) = FL2.Cells(lig, 22)



ElseIf (FL2.Cells(lig, 26) <> "") Then
FL2.Cells(col, 25) = FL2.Cells(lig, 25)
FL2.Cells(col, 26) = FL2.Cells(lig, 26)
FL2.Cells(col, 27) = FL2.Cells(lig, 27)



ElseIf (FL2.Cells(lig, 31) <> "") Then

FL2.Cells(col, 30) = FL2.Cells(lig, 30)
FL2.Cells(col, 31) = FL2.Cells(lig, 31)
FL2.Cells(col, 32) = FL2.Cells(lig, 32)


ElseIf (FL2.Cells(lig, 37) <> "") Then

FL2.Cells(col, 36) = FL2.Cells(lig, 36)
FL2.Cells(col, 37) = FL2.Cells(lig, 37)
FL2.Cells(col, 38) = FL2.Cells(lig, 38)

ElseIf (FL2.Cells(lig, 42) <> "") Then

FL2.Cells(col, 41) = FL2.Cells(lig, 41)
FL2.Cells(col, 42) = FL2.Cells(lig, 42)
FL2.Cells(col, 43) = FL2.Cells(lig, 43)


End If

End Function

Sub grouper()
Dim FL2 As Worksheet, i As Integer, j As Integer, h As String, lig As Integer, col As Integer
Set FL2 = Worksheets(4)

For i = 10 To 50
For j = 9 To i - 1
If ((FL2.Cells(i, 2) Like FL2.Cells(j, 2)) And (FL2.Cells(i, 3) Like FL2.Cells(j, 3)) And (FL2.Cells(i, 4) Like FL2.Cells(j, 4)) And (FL2.Cells(i, 5) Like FL2.Cells(j, 5))) Then
col = j
lig = i
h = inserer(FL2, lig, col)
Rows(i).Delete
End If
Next j
Next i
End Sub

 

[softimen]

Bonjour ,

Merci beaucoup , vraiment vous êtes fort en VBA .
C'est ce que je voulais exactement .Merci pour votre temps.
Mon probléme est résolu .

 

[softimen]

Bonjour ,

Je reviens vers vous comme j'ai besoin d'une petite modification s'il vous plait et je serai trés reconnaissante .

en effet , je voudrais lors de fusion , si colonne Y <> " alors colonne S =colonne T
et si colonne AD <> "" alors colonne Y ET S = AD .

est ce que c'est fesable ?
'je vous joint un fichier pour mieux expliquer .

' code VBA
Function fusionner(FL2 As Worksheet, FromLigne As Integer, ToLigne As Integer)

For j = 19 To 44 'pour les colonnes S à AR
If FL2.Cells(FromLigne, j) <> "" Then 's'il y a quelque chose à recopier à partir de la ligne "FromLigne"
FL2.Cells(ToLigne, j) = FL2.Cells(ToLigne, j) & FL2.Cells(FromLigne, j)
Else
FL2.Cells(ToLigne, j) = FL2.Cells(ToLigne, j)
End If
Next j

End Function

Sub grouper()
Application.ScreenUpdating = False
Dim FL2 As Worksheet, i As Integer, j As Integer, h As String, FromLigne As Integer, ToLigne As Integer
Set FL2 = ActiveSheet 'Worksheets(4)
With FL2
FinFeuille = .Range("B" & .Rows.Count).End(xlUp).Row 'récupère la dernière ligne du tableau
For i = FinFeuille To 10 Step -1 'pour chaque ligne en partant du BAS
For j = i - 1 To 9 Step -1 'pour chaque ligne au dessus de la ligne i en cours
'si les colonnes BCDEF de la ligne i sont identiques
If ((.Cells(i, 2) Like .Cells(j, 2)) And (.Cells(i, 3) Like .Cells(j, 3)) And (.Cells(i, 4) Like .Cells(j, 4)) And (.Cells(i, 5) Like .Cells(j, 5))) Then
ToLigne = i 'le nom de la varialbe "Col" était quand meme très mal choisi.. vu qu'il s'agit aussi d'un numéro de ligne..
FromLigne = j
h = fusionner(FL2, FromLigne, ToLigne) 'le nom "inserer" prête à confusion, puisqu'il s'agit plutot de fusionner deux lignes....
Rows(j).ClearContents
'i = i - 1
End If
Next j
Next i
.Range("B9:B" & FinFeuille).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Application.ScreenUpdating = True
End Sub



en vous remerciant d'avance

 

[vgendron]

Hello

dans ton fichier, tu n'as pas remis la bonne macro "Grouper"
je t'avais également proposé une autre macro "Grouper2" plus rapide. sur 20 lignes, la différence ne se fait pas sentir. mais sur 20 000.. ca risque d'être flagrant.

==> j'ai remis les deux dans le fichier, et j'ai corrigé les 2 pour les dates de fermetures (dernière demande)

 

[softimen]

Bonjour ,

Merci beaucoup pour votre retour rapide .Vous étés très gentil .Vous avez raison , avec cette macro c'est plus rapide .
Sauf que j'ai pas compris l'esprit comme je suis debutant dans VBA , est ce que c'est possible de m'explique le code avec des commentaires s'il vous plait ?
pour aprés , je peux apprendre l'esprit de développement de ce deuxième code .

Je vous remercie ennormement pour votre aide et votre temps

 

[softimen]

Bonjour , j'ai besoin de votre aide comme vous etes fort en vba

mon probléme :
Ma macro fonctionne avec un Menu contextuel .Donc je voudrais quand utilisateur fini a remplir toute une ligne, après quand il clique sur le souris ou s'est nommé "duplication de la ligne " ; un message Box montre n° de trajet de début ,après un autre message Box ,n°de trajet de fin .
Donc a partir de n° trajet de début jusqu’au numéro de trajet de fin , il incrémente avec un +1 , avec recopie de toute la ligne .

'exemple :
N° trajet de debut :580
N) trajet de fin: 584
donc je voudrai avoir
581
582
583
584
avec coipe de tout les données de la ligne de n0 de trajet 581 de debut pour les autres numéros de trajet .
' code VBA
Sub dupliquerlignes()
Dim lignes As Integer
Dim debut As Integer
debut = InputBox("N° DE DEBUT ")
fin=InputBox("N °DE FIN ")
For Debut To Fin
With ActiveCell.EntireRow
.Offset(debut, 0).Insert Shift:=xlDown
.Copy Destination:=.Offset(debut, 0)
debut=debut+1
End With
Next debut
End Sub
' Menu contextuel

Private Sub Workbook_Open()
Call Creer_Menu_Contextuel_2
End Sub

Sub Creer_Menu_Contextuel_2()

'réinitialize la sourie comme à l'origine
Application.CommandBars("Cell").Reset

'Crée une commande dans le menu
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = "Duplication de la ligne" 'le nom de la commande
.BeginGroup = True 'ligne facultative si elle est précisée alors
.OnAction = "dupliquerlignes" 'appel de la macro

End With

End Sub

Sub reset_menudroit()
CommandBars("Cell").Reset
End Sub

j'espere que j'ai bien expliquer mon probléme .
Dans l'attente de vos répense .Je vous remercie d'avance

 

[vgendron]

Voir PJ avec explications de la macro "Grouper2"
j'ai meme remis les formules en colonnes NOPQR
pour le reste. je regarde un peu plus tard.. Note: dans l'autre post que tu as ouvert, mets un lien vers celui ci. comme il s'agit du meme projet, autant rester ici.

 

[softimen]

Bonsoir,

je vous remercie enormement pour votre aide pour mon projet comme je suis débutante et pour l'explication de votre code .Vous étés très gentil . Merci.
Vous trouvez ci_joint le lien
https://www.excel-downloads.com/threads/duplication-de-la-ligne-avec-incrementation.20023790/
.
Dans l'attente de votre réponse .

 

[softimen]

Bonjour Vgendron
Tout d'abord ,je vous remercie pour votre aide .
Pour mieux comprendre mon probleme de duplication ; je vous joint un fichier excel .
Dans l'attente de votre reponse .Merci

 

[vgendron]

Hello
voir en PJ

 

[softimen]

Hello ,
Merci beaucoup , vous avez tout compris, ça fonctionne trés bien . Problémé résolu .
Merci beaucoup vraiement ,vous etes fort en VBA . Je suis trés reconnaissante pour votre aide .

 

[softimen]

Bonjour Vgendron,

En commençant , je vous remercie pour ton aide pour les macros.
J'ai besoin de votre aide s'il vous plait ; je suis bloquée sur mon projet sur cette macro.Tu peux m'aider s'il vous plait.
J'espere que j'ai bien expliquée mon souci .
https://www.excel-downloads.com/threads/gerer-un-calendrier.20023887/.
Dans l'attente de votre reponse .