On veut consolider des onglets.
Sub consolide_onglets()
Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear
For s = 2 To Sheets.Count
Range(Sheets(s).[A2], Sheets(s).[A65000].End(xlUp).End(xlToRight)).Copy
_
[A65000].End(xlUp).Offset(1, 0)
Next s
On Error Resume Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Sub consolide_onglets2()
Sheets("base").[A1].CurrentRegion.Offset(1,
0).Clear
For s = 2 To Sheets.Count
nlig = Sheets(s).[A65000].End(xlUp).Row
- 1
ncol = Sheets(s).[A1].CurrentRegion.Columns.Count
[A65000].End(xlUp).Offset(1, 0).Resize(nlig, ncol).Value
= _
Sheets(s).[A2].Resize(nlig, ncol).Value
Next s
On Error Resume Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Sub consolide_ongletsCollageSpecial()
Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear
For s = 2 To Sheets.Count
nlig = Sheets(s).[A65000].End(xlUp).Row - 1
ncol = Sheets(s).[A1].CurrentRegion.Columns.Count
Sheets(s).[A2].Resize(nlig, ncol).Copy
[A65000].End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
Next s
On Error Resume Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Sub consolide_ongletsNomOnglet()
Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear
For s = 2 To Sheets.Count
nlig = Sheets(s).[A65000].End(xlUp).Row
- 1
ncol = Sheets(s).[A1].CurrentRegion.Columns.Count
[A65000].End(xlUp).Offset(1, ncol).Resize(nlig,
1).Value = Sheets(s).Name
[A65000].End(xlUp).Offset(1, 0).Resize(nlig,
ncol).Value = _
Sheets(s).[A2].Resize(nlig, ncol).Value
Next s
On Error Resume Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Sub consolide_ongletsNomOngletCouleur()
Sheets("base").[A1].CurrentRegion.Offset(1, 0).Clear
For s = 2 To Sheets.Count
nlig = Sheets(s).[A65000].End(xlUp).Row - 1
ncol = Sheets(s).[A1].CurrentRegion.Columns.Count
[A65000].End(xlUp).Offset(1, ncol).Resize(nlig, 1).Value = Sheets(s).Name
[A65000].End(xlUp).Offset(1, 0).Resize(nlig, ncol + 1).Interior.ColorIndex =
_
Sheets(s).[A2].Interior.ColorIndex
[A65000].End(xlUp).Offset(1, 0).Resize(nlig, ncol).Value = _
Sheets(s).[A2].Resize(nlig, ncol).Value
Next s
On Error Resume Next
[A:A].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub