Seddiki_adz
XLDnaute Impliqué
comment modifier ce code vba si je veut juste consolider des onglets définie par leur nom
Sub Consolider()
Dim lig As Long, w As Worksheet, h As Long
Feuil1.Activate 'CodeName de "Consolidation Synthèse"
Application.ScreenUpdating = False 'fige l'écran
Rows("5:" & Rows.Count).Delete 'vidage
lig = 5 '1ère ligne à remplir
For Each w In Worksheets
If w.Name <> ActiveSheet.Name Then
h = w.Cells(Rows.Count, 2).End(xlUp).Row - 4
If h > 0 Then
w.[5:5].Resize(h).Copy Cells(lig, 1)
lig = lig + h
End If
End If
Next
If lig = 5 Then Exit Sub 'si aucun nom
With [5:5].Resize(lig - 5)
.Sort [B5], Header:=xlNo 'tri sur colonne B
'---épuration---
.Columns(2).Replace " ", "", LookAt:=xlWhole
On Error Resume Next
.Columns(2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
Merci
Sub Consolider()
Dim lig As Long, w As Worksheet, h As Long
Feuil1.Activate 'CodeName de "Consolidation Synthèse"
Application.ScreenUpdating = False 'fige l'écran
Rows("5:" & Rows.Count).Delete 'vidage
lig = 5 '1ère ligne à remplir
For Each w In Worksheets
If w.Name <> ActiveSheet.Name Then
h = w.Cells(Rows.Count, 2).End(xlUp).Row - 4
If h > 0 Then
w.[5:5].Resize(h).Copy Cells(lig, 1)
lig = lig + h
End If
End If
Next
If lig = 5 Then Exit Sub 'si aucun nom
With [5:5].Resize(lig - 5)
.Sort [B5], Header:=xlNo 'tri sur colonne B
'---épuration---
.Columns(2).Replace " ", "", LookAt:=xlWhole
On Error Resume Next
.Columns(2).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
Merci