Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !
Sub Onglets()
Dim r As Range
Set r = Range("C3", Range("C" & Rows.Count).End(xlUp))
If r.Row < 3 Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
For Each r In r
If IsError(Sheets(CStr(r))) Then
Sheets.Add After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = r
End If
'et après ???
Next
End Sub
Sub OngletsBis()
Dim r As Range
Set r = Range("C3", Range("C" & Rows.Count).End(xlUp))
If r.Row < 3 Then Exit Sub
Application.ScreenUpdating = False
On Error Resume Next
For Each r In r
If IsError(Sheets(CStr(r))) Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = r
End If
'et après ???
Next
End SubSub MAJ_feuilles()
Dim F As Worksheet, col%, P As Range, ncol%, d As Object, i&, j%
Application.ScreenUpdating = False
On Error Resume Next
Set F = Feuil1 'CodeName, à adapter
col = 3 'n° de colonne, à adapter
F.AutoFilterMode = False 's'il y a le filtre automatique
Set P = F.Rows("2:" & F.Cells(F.Rows.Count, col).End(xlUp).Row).Cells
ncol = P(1, F.Columns.Count).End(xlToLeft).Column 'dernière colonne
Set d = CreateObject("Scripting.Dictionary") 'pour éviter les doublons
For i = 2 To P.Rows.Count
If P(i, col) <> "" And Not d.exists(P(i, col).Value) Then
d(P(i, col).Value) = ""
'---création de la feuille si elle n'existe pas---
If IsError(Sheets(CStr(P(i, col)))) Then _
Sheets.Add(After:=Sheets(Sheets.Count)).Name = P(i, col)
With Sheets(CStr(P(i, col)))
'---mise en forme---
.Cells.Delete 'RAZ
P.Rows(0).Copy .[A1]
For j = 1 To ncol
.Columns(j).ColumnWidth = P(, j).ColumnWidth
Next
'---filtrage et remplissage de la feuille---
P.AutoFilter col, P(i, col) 'filtre automatique
P.SpecialCells(xlCellTypeVisible).Copy .[A2]
End With
End If
Next
F.AutoFilterMode = False 'suppression du filtre
F.Activate
End SubSub Création_feuilles()
Dim col%, r As Range
Application.ScreenUpdating = False
On Error Resume Next
With Feuil1 'CodeName de la feuille source, à adapter
col = 3 'n° de colonne, à adapter
Set r = .Cells(3, col).Resize(Application.Match("zzz", .Columns(col)) - 2)
If Not r Is Nothing Then
For Each r In r
If r <> "" Then If IsError(Sheets(CStr(r))) Then _
Sheets.Add(After:=Sheets(Sheets.Count)).Name = r
Next
.Activate
End If
End With
End SubPrivate Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim col%, af As Boolean, P As Range, ncol%, i%
With Feuil1 'CodeName de la feuille source, à adapter
col = 3 'n° de colonne, à adapter
If Application.CountIf(.Columns(col), Sh.Name) Then
Application.ScreenUpdating = False
af = .AutoFilterMode 'état du filtre automatique
.AutoFilterMode = False
Set P = .UsedRange.Offset(1).EntireRow.Cells
ncol = P(1, .Columns.Count).End(xlToLeft).Column 'dernière colonne
'---mise en forme---
Sh.Cells.Delete 'RAZ
P.Rows(0).Copy Sh.[A1]
For i = 1 To ncol
Sh.Columns(i).ColumnWidth = P(, i).ColumnWidth
Next
'---filtrage et remplissage de la feuille---
P.AutoFilter col, Sh.Name 'filtre automatique
P.SpecialCells(xlCellTypeVisible).Copy Sh.[A2]
.AutoFilterMode = af 'remise à l'état initial
End If
End With
End Sub
a = .Range(.[B1], .Cells(.Rows.Count, 1).End(xlUp)).Value a = .Range(.[B1], .Cells(.Rows.Count, 1).End(xlUp)).Value
ReDim Preserve a(1 To UBound(a), 1 To 1)
