Option Explicit
Dim wsTable As Worksheet
Dim lo As ListObject
Private Sub cmdClearTable_Click()
Application.ScreenUpdating = False
Set wsTable = ActiveWorkbook.Worksheets("A CDER")
Set lo = wsTable.ListObjects(1)
With lo
If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
End With
Set lo = Nothing: Set wsTable = Nothing
End Sub
Private Sub cmdConsolidateOrders_Click()
Dim ws As Worksheet
Dim rCell As Range
Dim xWS, tbl, tbl2, Arr()
Dim I As Long, k As Long
Dim nb, Fin As Integer
Application.ScreenUpdating = False
Set wsTable = ActiveWorkbook.Worksheets("A CDER")
Set lo = wsTable.ListObjects(1)
With lo
If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
Set rCell = .InsertRowRange.Cells(1)
End With
tbl = Array("RESERVE", "BRAINE", "ENGHIEN", "DEBROUKERE") 'liste des feuilles
For Each xWS In tbl
Set ws = ActiveWorkbook.Worksheets(xWS)
With ws.ListObjects(1)
.Range.AutoFilter Field:=3, Criteria1:="<>" 'on filtre sur la colonne 3
'AJOUTER test si résultat filtre vide - sinon. mettre un On error
On Error GoTo suivant
nb = .DataBodyRange.Columns(3).SpecialCells(xlCellTypeVisible).Count
.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy 'Copie du résultat du filtre
rCell.PasteSpecial Paste:=xlPasteValues 'colle dans la dernière ligne de la table
rCell.Offset(0, 9).Resize(nb, 1) = xWS
.Range.AutoFilter
End With
wsTable.ListObjects(1).ListRows.Add 'on ajoute une ligne vide en fin de tableau
Fin = wsTable.Range("B" & Rows.Count).End(xlUp).Row 'on récupère le numéro de la ligne
Set rCell = Range("B" & Fin) 'Select 'on reset rCell
suivant:
Next xWS
Set rCell = Nothing
Set lo = Nothing
Set ws = Nothing: Set wsTable = Nothing
End Sub