Résolu - Aide pour corriger une macro

[cmrt]

Bonjour

il y a plusieurs mois, j'avais demandé de l'aide sur le forum pour faire une macro permettant de recopier différents onglets sur un onglet récap.
J'ai, je pense, bien assimilé cette macro car j'ai réussi plusieurs fois à la faire évoluer en même temps que mon fichier. Je l'ai également adaptée à un autre fichier. Cependant, là, je n'y arrive pas.
J'ai mes onglets (4) et mes onglets récap (3) sur lesquels j'applique un tri. Pour les onglets "récap par titre" et "récap par auteur", la macro fonctionne mais pour le dernier onglet "récap par nom epub" elle ne fonctionne pas correctement : la copie se fait sur l'onglet "récap par titre" et en double. Je suppose donc qu'un onglet se copie alors qu'il ne devrait pas.
Voici la macro et le fichier.

Private Sub CopieUnePageTriTitreNomepub()

'Copie des données
Application.ScreenUpdating = False
Dim i As Integer, j As Integer, xrecapdlgn As Long, xongdlgn As Long
Range("A2:G65536").ClearContents
xrecapdlgn = Sheets("Récap. par nom epub").Range("C65536").End(xlUp).Row + 1
For i = 4 To ActiveWorkbook.Worksheets.Count
Worksheets(i).Activate
xongdlgn = Sheets(i).Range("C65536").End(xlUp).Row
For j = 2 To xongdlgn
If Range("C" & j) <> "" Then
Worksheets(i).Range("A" & j).Copy Worksheets("Récap. par nom epub").Range("A" & xrecapdlgn)
Worksheets(i).Range("B" & j).Copy Worksheets("Récap. par nom epub").Range("B" & xrecapdlgn)
Worksheets(i).Range("C" & j).Copy Worksheets("Récap. par nom epub").Range("D" & xrecapdlgn)
Worksheets(i).Range("D" & j).Copy Worksheets("Récap. par nom epub").Range("C" & xrecapdlgn)
Worksheets(i).Range("E" & j).Copy Worksheets("Récap. par nom epub").Range("E" & xrecapdlgn)
Worksheets(i).Range("F" & j).Copy Worksheets("Récap. par nom epub").Range("F" & xrecapdlgn)
Worksheets(i).Range("G" & j).Copy Worksheets("Récap. par nom epub").Range("G" & xrecapdlgn)
xrecapdlgn = xrecapdlgn + 1
End If
Next j
Next i
Range("I2").Select
Worksheets("Récap. par nom epub").Activate

'Tri des données
ActiveWorkbook.Worksheets("Récap. par nom epub").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Récap. par nom epub").Sort.SortFields.Add Key:=Range("C1:C65536"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Récap. par nom epub").Sort
.SetRange Range("A1:G65536")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("I2").Select
Application.ScreenUpdating = True
End Sub



Merci de votre aide.

 

[Yaloo]

Re : Aide pour corriger une macro

Bonsoir cmrt,

Il suffit juste de modifier la macro de ton bouton dans l'onglet Récap. par nom epub et de mettre CopieUnePageTriTitreNomepub, enfin si j'ai bien tout compris.

A+

Martial

 

[cmrt]

Re : Aide pour corriger une macro

Effectivement. Merci !
J'avais tout modifié sauf la macro affectée au bouton. Je m'arrachais les cheveux pour ça, heureusement grâce à toi il va m'en rester ;-)

Encore merci pour ce coup d'oeil expert !