PROBLEME AVEC UN MACRO

MAHARO

XLDnaute Nouveau
Bonjour,

Je sollicite votre aide sur ce macro,
ca ne renvoie que les titres sur la premiere ligne dans la feuille FEUIL1 et les titres dans la feuille FEUIL2
s'il vous plait

Salutation

VB:
Sub d1_a1()
    Dim i As Integer, derlig As Integer, j As Integer
    derlig = Range("A" & Rows.Count).End(xlUp).Row
    With Sheets("Recap")
        For i = 1 To derlig
            .Cells(i, 2) = Sheets("FEUIL1").Cells(i, 2)
            .Cells(i, 3) = Sheets("FEUIL1").Cells(i, 3)
            .Cells(i, 4) = Sheets("FEUIL1").Cells(i, 4)
            .Cells(i, 5) = Sheets("FEUIL1").Cells(i, 5)
            .Cells(i, 6) = Sheets("FEUIL1").Cells(i, 6)
            .Cells(i, 7) = Sheets("FEUIL1").Cells(i, 7)
            .Cells(i, 8) = Sheets("FEUIL1").Cells(i, 8)
            .Cells(i, 9) = Sheets("FEUIL1").Cells(i, 9)
        Next
            Sheets("Recap").Select
            For j = 1 To derlig
                If .Cells(j, 2) <> " " Then
                    .Cells(j + 1, 2) = Sheets("FEUIL2").Cells(j, 2)
                    .Cells(j + 1, 3) = Sheets("FEUIL2").Cells(j, 3)
                    .Cells(j + 1, 4) = Sheets("FEUIL2").Cells(j, 4)
                    .Cells(j + 1, 5) = Sheets("FEUIL2").Cells(j, 5)
                    .Cells(j + 1, 6) = Sheets("FEUIL2").Cells(j, 6)
                    .Cells(j + 1, 7) = Sheets("FEUIL2").Cells(j, 7)
                    .Cells(j + 1, 8) = Sheets("FEUIL2").Cells(j, 8)
                    .Cells(j + 1, 9) = Sheets("FEUIL2").Cells(j, 9)
                End If
            Next
    End With
End Sub
 

MAHARO

XLDnaute Nouveau
Merci pour la reponse mais ca ne resout pas la situation
je vais joindre le fichier pour exposer le probleme
Je vais quand meme expliquer quelque etapes que j"ai fait avant d"en arriver a la demande d"aide
em utilisant ce code
VB:
Sub d_a()
    Dim i As Integer, derlig As Integer, j As Integer
    derlig = Range("A" & Rows.Count).End(xlUp).Row
    With Sheets("RECAP")
        For i = 1 To derlig
            .Cells(i, 2) = Sheets("FEUIL1").Cells(i, 2)
            .Cells(i, 3) = Sheets("FEUIL1").Cells(i, 3)
            .Cells(i, 4) = Sheets("FEUIL1").Cells(i, 4)
            .Cells(i, 5) = Sheets("FEUIL1").Cells(i, 5)
            .Cells(i, 6) = Sheets("FEUIL1").Cells(i, 6)
            .Cells(i, 7) = Sheets("FEUIL1").Cells(i, 7)
            .Cells(i, 8) = Sheets("FEUIL1").Cells(i, 8)
            .Cells(i, 9) = Sheets("FEUIL1").Cells(i, 9)
        Next
    End with
        with sheets("RECAP")
         For i = 1 to derlig
            If .Cells(i, 2)<>" " then
                .Cells(i, 2) = Sheets("FEUIL2").Cells(i, 2)
                .Cells(i, 3) = Sheets("FEUIL2").Cells(i, 3)
                .Cells(i, 4) = Sheets("FEUIL2").Cells(i, 4)
                .Cells(i, 5) = Sheets("FEUIL2").Cells(i, 5)
                .Cells(i, 6) = Sheets("FEUIL2").Cells(i, 6)
                .Cells(i, 7) = Sheets("FEUIL2").Cells(i, 7)
                .Cells(i, 8) = Sheets("FEUIL2").Cells(i, 8)
                .Cells(i, 9) = Sheets("FEUIL2").Cells(i, 9)
            End If
        Next
    End With
End Sub
Mais le resultat c'est que en premier temps il affiche les donnees du feuil1 et l'efface en meme temps et apres remplace les donnees feuil1 en donnes feuilles deux
Salutation,
 

Pièces jointes

  • ENVOI.xlsm
    29.1 KB · Affichages: 2
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re

Dans ce cas, si j'étais moi, je ferais peut-être une macro de ce genre
VB:
Sub aTest()
Dim plg As Range
Sheets("FEUIL1").[A1].CurrentRegion.Copy Sheets("RECAP").[A2]
Sheets("FEUIL2").[A1].CurrentRegion.Copy Sheets("RECAP").Cells(Rows.Count, 1).End(3)(3)
Set plg = Sheets("RECAP").Columns(1).SpecialCells(xlCellTypeBlanks)
Range(Split(plg.Address, ",")(0)) = "FEUIL1"
Range(Split(plg.Address, ",")(1)) = "FEUIL2"
End Sub
 

Staple1600

XLDnaute Barbatruc
Re

Dans ce cas, il fallait le dire dès le message#1 car comme disait Nicolas
"Ce que l'on conçoit bien s'énonce clairement" ;)

PS: Et si j'étais moi, mais une nuit sans lune, je pourrais aussi ainsi l'écrire mon macro ;)
VB:
Sub bTest()
Dim plg As Range, f As Worksheet, x As Range
Set f = Sheets("RECAP")
With Sheets("FEUIL1").[A1]
.CurrentRegion.Copy f.[A2]: f.[A1] = .Parent.Name
End With
Set x = f.Cells(Rows.Count, 1).End(3)(2)
With Sheets("FEUIL2").[A1]
x = .Parent.Name
.CurrentRegion.Copy x.Offset(1)
End With
End Sub
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil,

MAHARO
Les macros que je t'ai proposées donnent le même résultat que ce qu'on peut voir sur la feuille RESULTAT CIBLE
(mais les macros recopient les données sur la feuille RECAP)
Si ce n'est pas là, le but visé alors je recapépéte ;)
"Ce que l'on conçoit bien s'énonce clairement"

Donc en clair, donne de plus de détails et d'explications.
 

MAHARO

XLDnaute Nouveau
Bonsoir,
Merci de s"interesser a mon sort ,en fait,je ne cherche pas a copier toute la plage , je joint le fichier , et dans l'onglet en vert "RESULTAT CIBLE (2)" se trouve le resultat que je cherche

Cordialement
 

Pièces jointes

  • ENVOI2.xlsm
    29.6 KB · Affichages: 3

Staple1600

XLDnaute Barbatruc
Bonsoir le fil,

MAHARO
On se rapproche du but avec ceci?
VB:
Sub cTest()
Dim plg As Range, f As Worksheet, x As Range, l&
Set f = Sheets("RECAP")
With Sheets("FEUIL1").[A1]
.CurrentRegion.Copy f.[A2]: f.[A1] = .Parent.Name
End With
Set x = f.Cells(Rows.Count, 1).End(3)(2)
With Sheets("FEUIL2").[A1]
x = .Parent.Name
.CurrentRegion.Copy x.Offset(1)
End With
l = f.Cells(Rows.Count, "G").End(3).Row
f.Range(f.Cells(x.Row + 1, "H"), f.Cells(l, "I")).Delete Shift:=xlToLeft
End Sub
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil,

MAHARO
Ou il faut harmoniser les structures de tes tableaux pour qu'ils soient identiques.
Ce qui simplifierait les choses pour la recopie sur la feuille RECAP.

On pourrait aussi envisager d'avoir les données sur une seule feuille puis de manipuler ces données avec un TCD (selon les besoins)
C'est cette piste que je suivrai si j'étais moi.
 

MAHARO

XLDnaute Nouveau
J'aurai aime l'harmoniser mais ce qui ne serait possible,je sais que je peut copier ce que je veux dans la feuil1 en feuil1 bis , feuil 2 en feuil2 bis , et les fusionners dans recap en tant que plage , mais ca me creera beaucoup de feuil si je le fait
mais aussi pourraiez vous s'il vous plait expliquer le code?
VB:
Sub cTest()
Dim plg As Range, f As Worksheet, x As Range, l&
Set f = Sheets("RECAP")'??????????????
With Sheets("FEUIL1").[A1]'??????????????
.CurrentRegion.Copy f.[A2]: f.[A1] = .Parent.Name'??????????????
End With
Set x = f.Cells(Rows.Count, 1).End(3)(2)'??????????????
With Sheets("FEUIL2").[A1]
x = .Parent.Name'??????????????
.CurrentRegion.Copy x.Offset(1)'??????????????
End With
l = f.Cells(Rows.Count, "G").End(3).Row'??????????????
f.Range(f.Cells(x.Row + 1, "H"), f.Cells(l, "I")).Delete Shift:=xlToLeft'??????????????
End Sub

Cordialement
 

Discussions similaires

Réponses
17
Affichages
760

Statistiques des forums

Discussions
311 720
Messages
2 081 907
Membres
101 836
dernier inscrit
karmon