Résolu 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
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

MAHARO
Au pif (puisque pas de fichier exemple fourni)
Essaies avec cette modif
derlig = Sheets("Recap").Range("A" & Rows.Count).End(xlUp).Row

PS: Dernier conseil, dimensionne tes variables en As Long
 

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,
 

Fichiers joints

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
 

MAHARO

XLDnaute Nouveau
Merci ,ca marche bien ,ce que je cherchait , mais disons que je veux faire c'est cibler certaine cellule dans feuil1 et feuil2 en vue d'avoir le resultat suivant

Cordialement
 

Fichiers joints

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
 

Fichiers joints

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
 

MAHARO

XLDnaute Nouveau
Superbe ça marche ,donc en conclusion si j'ai plusieurs feuilles dont les colonnes à copier ne sont pas forcément le même,il faut le faire cas par cas
Merci bien
 

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
 

MAHARO

XLDnaute Nouveau
ca se passerait commrent juste avec une debut d'explication avec un tcd,j'en ai deja fait un ou deux ou trois avant mais je m'en souvient plus

Cordialment
 

Staple1600

XLDnaute Barbatruc
Bonjour le fil,

Pour les TCD, il y a moult tutos sur le Web, accessibles avec un peu d'huile de coude et le moteur de recherche de ton choix.

Pour les explications de mon code, elles viendront dès que j'aurai fini de préparer apéro et BBQ ;)
 

Staple1600

XLDnaute Barbatruc
Re,

Code:
Sub dTest()
'Déclarations des variables
Dim plg As Range, f As Worksheet, x As Range, l&
Set f = Sheets("RECAP") 'La variable f correspond à la feuille RECAP
With Sheets("FEUIL1").[A1] 'On copie la "zone en cours"
'de la feuille FEUIL1 vers la cellule A2 de f
.CurrentRegion.Copy f.[A2]: f.[A1] = .Parent.Name
'On inscrit de le nom de la feuille FEUIL1 en A1 de f
End With
'On définit la variable x comme étant la 1ère cellule vide
'après la  dernière cellule non vide de la colonne 1 de f
Set x = f.Cells(Rows.Count, 1).End(3)(2)
'Même logique de recopie que pour FEUIL1
With Sheets("FEUIL2").[A1]
x = .Parent.Name 'nom de la feuille FEUIL2
.CurrentRegion.Copy x.Offset(1) 'recopie
End With
'détermination de la dernière ligne non vide
l = f.Cells(Rows.Count, "G").End(3).Row
'Suppression des colonnes surnuméraires
f.Range(f.Cells(x.Row + 1, "H"), f.Cells(l, "I")).Delete Shift:=xlToLeft
End Sub
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas