Bonjour, me revoici avec une réponse que je pense complète:
En effet, sous excel 2007, j'ai le même problème. Mais, en faisant le pas à pas de l'exécution (F8), on voit que le problème vient de l'instruction If ws.Name <> "recap"
Elle vise à ne pas traiter la feuille "recap"; mais si vous l'avez appelée "Recap", ou" récap" (etc..), le test d'exclusion ne fonctionne pas et donc la feuille de synthèse est aussi traitée comme les autres. Donc tout ce qui y a été copié est encore une fois recopié. Donc si trois feuilles réelles, on obtient au final 6 contenus dans la feuille résultat.
Pour rendre le test fiable, il faut donc que le nom de la feuille de synthèse soit exactement ce qui est testé dans le programme. On pourrait écrire: If UCase(ws.Name) <> UCase("recap"), mais cela ne règle pas la question de "récap" à cause de l'accent, ni le VBA : Destination:=Worksheets("recap"), qui utilise le nom sensé être celui de la feuille de synthèse, même si on écrit Destination:=Worksheets(UCase("recap")).
Une solution simple serait de nommer cette feuille RECAP sans accent et en majuscule et de la tester comme telle dans le programme.
Pour imposer qu'il en soit ainsi, on pourrait commencer par tester la présence d'une telle feuille avec ce nom-là ; et si pas trouvé, on arrête la macro.
Remarque : Mais cela ne règle pas la présence éventuelle supplémentaire d'une "récap" avec accent ; si elle est présente en plus de RECAP, elle sera traitée comme une feuille ordinaire et donc copiée dans RECAP ; si elle est seule, alors la macro s’arrêtera.
Il y a cependant un AUTRE problème important: cette macro ne marche que si chaque cellule de chaque ligne est garnie dans les feuilles à recopier. Ou, à tout le moins, que chaque cellule de la colonne A est garnie. Cela est dû au test range A65536 dans Destination:=Worksheets(FeuilleSynthName).Range("A65536")
Si par exemple vous encodez :
en feuille1 uniquement les cellules A1, B2, B3, C3
en feuille2 uniquement les cellules B2, C3
en feuille3 uniquement les cellules A1, C4
vous serez surpris du résultat: "tout" est superposé dans les premières lignes de la feuille RECAP, en fonction de la présence au non de données dans les cellules en An. Et donc au fil des « copy » successifs, des valeurs sont perdues au profit d’autres.
Pour résoudre cela, il, faut calculer, avant chaque « copy », où l’on en est dans la feuille de synthèse, grâce à l’instruction suivante :
NbLignesFeuilleSynth = Worksheets(FeuilleSynthName).Range(Worksheets(FeuilleSynthName).Range("A1"), Worksheets(FeuilleSynthName).Range("A1").SpecialCells(xlCellTypeLastCell)).Rows.Count
Et de l’utiliser pour se positionner dans cette feuille par ceci :
Destination:=Worksheets(FeuilleSynthName).Range("A1").Offset(NbLignesFeuilleSynth + 1, 0)
Remarque : L’offset +1 va provoquer le saut d’une ligne de séparation entre deux copy. Si on n’en veut pas, enlever le « +1 »
Enfin, l’instruction suivante va afficher la RECAP à la fin de la macro :
Worksheets(FeuilleSynthName).Activate
Et
Set ws = Nothing
réinitialise l’objet ws (bonne pratique à prévoir en fin de macro).
La macro complète corrigée devient donc :
Sub test2()
Dim ws As Worksheet
Dim NbFeuilleSynth As Integer
Dim NbLignesFeuilleSynth As Integer
Dim FeuilleSynthName As String
' test présence feuille de synthèse
FeuilleSynthName = "RECAP"
NbFeuilleSynth = 0
For Each ws In Worksheets
If ws.Name = FeuilleSynthName Then NbFeuilleSynth = NbFeuilleSynth + 1
Next
If NbFeuilleSynth = 0 Then
MsgBox "il n'y a aucune feuille nommée: " & FeuilleSynthName
GoTo EndOfProcess
End If
'boucle copy/paste vers la feuille de synthèse
For Each ws In Worksheet
If UCase(ws.Name) <> FeuilleSynthName Then
NbLignesFeuilleSynth = Worksheets(FeuilleSynthName).Range(Worksheets(FeuilleSynthName).Range("A1"), Worksheets(FeuilleSynthName).Range("A1").SpecialCells(xlCellTypeLastCell)).Rows.Count
ws.Range(ws.Range("A1"), _
ws.Range("A1").SpecialCells(xlCellTypeLastCell)).Copy _
Destination:=Worksheets(FeuilleSynthName).Range("A1").Offset(NbLignesFeuilleSynth + 1, 0)
End If
Next
' affichage feuille de synthèse
Worksheets(FeuilleSynthName).Activate
EndOfProcess:
Set ws = Nothing
End Sub
