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
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
 

Discussions similaires

Réponses
17
Affichages
816

Statistiques des forums

Discussions
312 163
Messages
2 085 859
Membres
103 005
dernier inscrit
gilles.hery