Synthèse des onglets dans un autre onglet

Version imprimable

Bonjour,

J'ai une feuille avec plusieurs onglets et je voudrais recopier les données des onglets 5 à la fin dans l'onglet 4 ("Synthèse").
Les infos à récupérer sont contenues dans un tableau de A15 à FXX, et doivent être écrites dans un tableau de A2 à FXX.

J'ai écris un macro mais il ne récupère que la première ligne de l'onglet 5 et la deuxième ligne de l'onglet 7.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 Sub Compilation() Dim i As Long, j As Long Worksheets("Synthèse").Select For i = 5 To Worksheets.Count j = i - 1 For k = i - 1 To 30 With Worksheets(i) Cells(j, 1).Value = .Range("A" & k + 11).Value Cells(j, 2).Value = .Range("B" & k + 11).Value Cells(j, 3).Value = .Range("C" & k + 11).Value Cells(j, 4).Value = .Range("D" & k + 11).Value Cells(j, 5).Value = .Range("E" & k + 11).Value Cells(j, 6).Value = .Range("F" & k + 11).Value End With j = j + 1 Next Next End Sub
Merci :)

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Compilation()
Dim LastLig As Long, NewLig As Long
Dim i As Integer
 
Application.ScreenUpdating = False
If Worksheets.Count >= 5 Then
    NewLig = 2
    For i = 5 To Worksheets.Count
        With Worksheets(i)
            LastLig = .Cells(.Rows.Count, "A").End(xlUp).Row
            If LastLig >= 15 Then
                'Pour copier
                '.Range("A15:F" & LastLig).Copy Worksheets("Synthèse").Range("A" & NewLig)
                'Pour transférer les valeurs
                Worksheets("Synthèse").Range("A" & NewLig & ":F" & NewLig + LastLig - 15).Value = .Range("A15:F" & LastLig).Value
                NewLig = NewLig + LastLig - 14
            End If
        End With
    Next i
End If
End Sub

24/03/2012, 18h45
Ghuillaume

Merci, ça fonctionne :P
24/03/2012, 21h46
kiki29

Salut, avec retard, voir http://www.developpez.net/forums/d11...uille-feuille/