Discussion :

[papar12]

"Bonsoir"

Demande de code VBA Excel Copier et Coller / des contenus Feuil 1, Feuil 2 , Feuil 3 , Feuil 4 …………… Vers Feuil 5 dans le Même Classeur
Merci

[Bear the french]

Bonsoir,

Considérons Feuil1, Feuil2, Feuil3, Feuil4 et Feuil5 préalablement créés et seuls onglets présents,
Considérons Feuil5 vide,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Sub faitotalonglet()
'---------------------------------------------------------------------------------------
'Macro qui copie toutes les lignes de tous les onglets "Feuil1, Feuil2, Feuil3, Feuil4" dans "Feuil5"
'---------------------------------------------------------------------------------------
 
    Dim Fe As Worksheet
    Dim Plage As Range
 
    'Parcours la collection en évitant la feuille "Feuil5"
    For Each Fe In ThisWorkbook.Worksheets
 
        If Fe.Name <> "Feuil5" Then
 
            With Fe
                'définie la plage à copier
               Set Plage = .Range(.Cells(1, 1), .Cells(.Cells.Find("*", .[A1], -4123, , 1, 2).Row, .Cells.Find("*", .[A1], -4123, , 2, 2).Column))
            End With
 
            'colle les valeurs dans la feuille "Feuil5"
            'après la dernière ligne non vide
            Plage.Copy Worksheets("Feuil5").Range("A65500").End(xlUp).Offset(0, 0)
 
        End If
 
    Next Fe
 
End Sub

J'ai simplement adapté une réponse faite sur ce forum hier...

Bertrand

[Bear the french]

Bonsoir,

Autre solution plus rapide mais à la condition que la colonne A de chaque feuille soit systématiquement remplie pour chaque ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub ConcatenationFeuilles()
Dim i As Long, T() As Variant
 
    Application.ScreenUpdating = False
    Sheets("Feuil5").Cells.Clear
 
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name <> "Feuil5" Then
            With Worksheets(i)
                T = .Range("A1:P" & .Range("A" & Rows.Count).End(xlUp).Row).Value
                Sheets("Feuil5").Range("A" & Rows.Count).End(xlUp).Offset(0).Resize(UBound(T, 1), UBound(T, 2)) = T
            End With
        End If
    Next i
 
    Erase T
 
    Application.ScreenUpdating = True
End Sub

Regardes le post suivant pour t'en inspirer : POST

Bertrand

[kiki29]

Salut, voir ici, Post# 2 pour un code correct. Il est supposé que les feuilles possèdent un en-tête et que ce dernier n'est copié qu'une fois.

[papar12]

merci beaucoups