Fusion lignes excel

Sub Fusion()
Dim lig As Long, Col As Integer
Application.ScreenUpdating = False
lig = 2
With Sheets("Feuil1")
While .Cells(lig, 1) <> ""
While .Cells(lig, 1) = .Cells(lig + 1, 1)
For Col = 2 To 28
If .Cells(lig + 1, Col) <> "" Then
.Cells(lig, Col) = .Cells(lig, Col) + .Cells(lig + 1, Col)
Debug.Print .Cells(lig, Col)
End If
Next Col
.Rows(lig + 1).Delete
Wend
lig = lig + 1
Wend
End With
Application.ScreenUpdating = True
End Sub
Pour appliquer tu fais la même chose que la 1ère fois.
Met les largeurs colonnes à 4,3
Tu dis..

bonjour,

merci pour votre aide, je vais essayer cette solution en attendant la macro définitive

MErci encore et bonne journée

Bonsoir
En attendant mieux, une solution mi-macro :

les données en feuil1
feuil2, en B2 on entre : =SOMME.SI(Feuil1!$A$2:$A$2279;$A2;Feuil1!B$2:B$2279)*(Feuil1!B$1=Feuil2!B$1)
on étire jusqu'a AB2
en AC2, on entre bien sur : =SOMME(B2:AB2)
On sélectionne de B2 à AC2 et on étire vers le bas d'un nombre de lignes égal ou supérieur au nombre de valeurs différentes en colonne A de feuil1.

On colle la macro suivante en feuil2 :

Sub Macro2()
'
' Macro2 Macro
' Macro enregistrée le 12/03/2009 par
'
'
Dim Lig As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long

Sheets("feuil2").Activate
Col = "a"
NumLig = 1
Lig = 1
With Sheets("feuil1")
.Cells(Lig, Col).EntireRow.Copy
ActiveSheet.Paste Destination:=Worksheets("feuil2").Range("A1")

NumLig = 2
Lig = 2
.Cells(Lig, Col).Copy
Sheets("feuil2").Paste Destination:=Cells(NumLig, Col)

NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 3 To NbrLig
If .Cells(Lig, Col).Value <> .Cells(Lig - 1, Col).Value Then
.Cells(Lig, Col).Copy
NumLig = NumLig + 1
Sheets("feuil2").Paste Destination:=Cells(NumLig, Col)
End If
Next
End With

End Sub

et on éxécute Macro2

Bien sur, si le nombre de valeurs en ligne 1 est supérieur à l'exemple, il faudra modifier, mais on peut prévoir +large dés le début.

OK, compris ta demande, laisse moi un peu de temps, pour le moment je suis pas trop disponnible, si un autre intervenant veux t'aider.. sinon ce sera pour demain ou après demein.
A+

Fusionner les lignes n'aditionne pas leurs contenu, du moins à ma connaissance.

Prennons plutôt le 2632, si j'ai compris, tu veux 7,4 dans la colonne D ?

Bon, beh BV pour moi... ça veux rien dire
et oui, met moi un résulat souhaiter pour que je comprenne
parce que jusqu' ici.. j'ai pas compris.

Re.. bonjour,
Effectivement le code précédant ne va pas convenir.
Si j'ai bien compris tu veux remettre toutes les donnée sur les première lignes et supprimer quand elle sont déplacées ?
Ca va être beaucoup plus compliquer comme macros, laisse moi un peu de temps, je cogite pour avoir une solution.
Tu a beaucoup de fichier de ce genre ? parce qu'une macros pour une seule fois ça ne vaut pas la peine.
Tu dis

Bonjour,

voila j'aurai de nouveau besoin d'un petit programme pour me simplifier la vie :)

Je pense qu'il s'agit presque du meme que celui précedent, je poste mon tableau ci joint :

http://www.cijoint.fr/cjlink.php?file=cj200903/cijtZvIivg.xls

en fait j'ai un numéro de site(premiere colonne)
des valeurs d'occupâtions du sol
des pourcentages

J'aimerais obtenir une seule ligne par numéro de site avec un pourcentage pour chaque occ sol

Je pensais pouvoir réutiliser celui du dessus mais apparement pas....

Merci beaucoup une nouvelle fois pour votre aide si précieuse
Cordialement, nicolas

Super, tout fonctionne!!!

Merci beaucoup pour ton aide

Bonne journée et à bientot

Dans Excel ...
Alt+F11 pour entrer dans l'IDE du VBA
sur le menu >> Insertion >> Module
C'est dans cette nouvelle fenêtre que tu colle le code.
Tu peu ensuite mettre le curseur DANS la macros et taper F5 pour exécuter.
Pour éviter les erreurs j'ai rectifier la macros, emploi celle ci-dessous.

Sub Dedouble()
Dim Lig As Long
Dim Col As Integer
Dim TP
    Application.ScreenUpdating = False
    Lig = 1
    With Sheets("Feuil1")
        TP = .Cells(Lig, 2)
        Lig = Lig + 1
        While .Cells(Lig, 2) <> ""
            If .Cells(Lig, 2) = TP Then
                For Col = 4 To 26
                    If .Cells(Lig, Col) <> "" Then
                        .Cells(Lig - 1, Col) = .Cells(Lig - 1, Col) + .Cells(Lig, Col)
                    End If
                Next Col
                .Rows(Lig).Delete
            Else
                TP = .Cells(Lig, 2)
                Lig = Lig + 1
            End If
        Wend
    End With
    Application.ScreenUpdating = True
End Sub

Pour adapter à d'autre feuille faut changer
"Feuil1" par le nom de la feuille
Lig = la 1ère ligne à traiter
Exemple: si tu a 2 lignes de titres faut mettre 3
Tu dis...

Merci beaucoup pour ton travail.

Par contre ne connaissant pas du tout ce genre d'opération, je voulais savoir ou je devais mettre cette expression?

Et surtout comment je peux l'appliquer aux autres tableaux que j'aurai a traité par la suite

Encore merci

Avant d'employer la macros fait une copie de la feuille... ont ne sait jamais.
Je l'ai tester et cela m'a l'air de correspondre à ce que tu veux.
Tu colle le code dans un module général.

Sub Dedouble()
Dim Lig As Long
Dim Col As Integer
Dim TP
    Application.ScreenUpdating = False
    Lig = 2
    With Sheets("Feuil1")
        TP = Cells(1, 2)
        While Cells(Lig, 2) <> ""
            If Cells(Lig, 2) = TP Then
                For Col = 4 To 26
                    If Cells(Lig, Col) <> "" Then
                        Cells(Lig - 1, Col) = Cells(Lig - 1, Col) + Cells(Lig, Col)
                    End If
                Next Col
                Rows(Lig).Delete
            Else
                TP = Cells(Lig, 2)
                Lig = Lig + 1
            End If
        Wend
    End With
    Application.ScreenUpdating = True
End Sub

Ca prend quand même quelques secondes.
Et tu peu avantageusement remplacer les formules que tu a en AA par

=SOMME(D1:Z1)

que tu met sur la 1ère ligne ensuite tu copie vers le bas.
Tu dis...

oui bien sur, il n'y a pas de probleme.

J'attends ta réponse soit ce soir soit pour demain.

Merci encore pour ton aide

Bonne fin de journée

OK, mais je doit m'absenter, ce serra pour la soirée ou demain.
A+

non j'ai fait un classement par no de site donc ils se suivent

Encore une question, pour éviter de surcharger la fonctions
Je remarque que les N° en colonne B, quand il sont identiques les lignes se suivent !
Pourrait-il arriver que ce même N° se retrouve 25, ou xx nombre lignes plus loin.
Si oui, la macros va prendre un temps fou avec le nombre de lignes que tu a.

Pour le moment je fais tout à la main...

Mais c'est surtout pour avoir un modele car aprés j'aurai d'autres tableau à traité comme celui ci qui seront plus grand

Un modele pourrait me faire gagner beaucoup de temps :)

MErci

oui tout à fait, comme dans le début de mon tableau en fait

Si je comprend bien,
Tu voudrais sélectionner les lignes qui ont le même N° dans la colonne B et qu'il n'y ai plus qu'une seule ligne mais avec les données des autres lignes, ensuite supprimer les ligne en doublons ?
Tu dis