Compiler plusieurs onglets
Bonjour,
je m'adresse a vous car, bien que j'ai cherché, lu et tenté plusieurs réponses dans des sujets différents, je n'arrive pas à réaliser la macro souhaitée..
En effet, j'ai a ma disposition un excel comportant plusieurs onglets qui seront amenés à être de plus en plus nombreux au fil du temps. Chacun de ces onglets est organisé de la même manière sous la forme d'un tableau. Je cherche aujourd'hui à obtenir ne macro mettant bout à bout les valeurs de ces tableaux afin de créer un onglet comportant un tableau récapitulatif.
Sauriez vous m'expliquer comment faire pour arriver à cela? :/
Voici un exemple d'excel avec sr le dernier onglet, le résultat cherché, obtenu par copier coller manuel, mais solution qui n'est plus envisageable avec d'autre excels..
Merci beaucoup
Bon après midi
EDIT :
Bon, alors, en récupérant un code d'ailleurs et en le retravaillant, j'obtient ça qui me crée une feuille, l'édite en nom, et la rempli comme indiqué ci -dessus.. Après je sais pas quelles sont les limites de ce code.
Sub Compilation()
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = "Compilation"
Dim Fe As Worksheet
Dim Plage As Range
'parcour la collection en évitant la feuille
'de consolidation
For Each Fe In ThisWorkbook.Worksheets
If Fe.Name <> "Compilation" Then
With Fe
'définie la plage sans la ligne de titres
Set Plage = .Range(.Cells(5, 1), _
.Cells( _
.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, _
.Cells.Find("*", .[A1], -4123, , _
2, 2).Column))
End With
'colle les valeurs dans la feuille de consolidation
'après la dernière ligne non vide
Plage.Copy _
Worksheets("Compilation").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next Fe
End Sub
Au fait, quelqu'un pourrait il m'expliquer s'il vous plait, comment fonctionnent les commandes intégrées au code ci dessus :
Set Plage = .Range(.Cells(5, 1), _
.Cells( _
.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, _
.Cells.Find("*", .[A1], -4123, , _
2, 2).Column))
Encore merci
Bonjour,
Voir fichier (Ctrl + w pour lancer la procédure)
Cdlt.
Option Explicit
' Ctrl + w
' pour lancer la procédure
Public Sub Consolidation_Feuilles()
Dim ws As Worksheet, wsd As Worksheet
Dim lastRow As Long
Dim rng As Range
Application.ScreenUpdating = False
Set wsd = Worksheets("Resultat")
With wsd
Set rng = .Range("A1").CurrentRegion
lastRow = wsd.Range("A" & Rows.Count).End(xlUp).Row
If lastRow > 1 Then rng.Offset(1, 0). _
Resize(rng.Rows.Count - 1, rng.Columns.Count + 1).Delete
End With
lastRow = 2
For Each ws In ActiveWorkbook.Worksheets
If Not IsEmpty(ws.Cells(1, 1)) And ws.Name <> wsd.Name Then
Set rng = ws.Range("A1").CurrentRegion
rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count + 1). _
Copy Destination:=wsd.Cells(lastRow, 1)
End If
lastRow = wsd.Range("A" & Rows.Count).End(xlUp).Row + 1
Next
Set wsd = Nothing: Set rng = Nothing
End Sub
Merci beaucoup de ton aide, j'ai réussi à créer un code qui marche parfaitement.
=)