Dim oSheet As Worksheet Dim bTrouvé As Boolean Dim oRange As Range For Each oRange In Range("A1:A200") If oRange.Value <> vbNullString Then bTrouvé = False For Each oSheet In ActiveWorkbook.Sheets If oSheet.Name = oRange.Value Then bTrouvé = True Exit For End If Next If Not bTrouvé Then ' Pas trouvé : on crée la feuille à la suite des autres Set oSheet = ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)) oSheet.Name = oRange.Value End If End If Next
Merci, excuse je suis un bleu. le code était de fcfoutu.
Dim derlig As Long, i As Integer, zone, feuilles feuilles = "" For Each f In Worksheets feuilles = feuilles & Chr(1) & Trim(UCase(f.Name)) Next feuilles = UCase(feuilles & Chr(1)) derlig = Range("A" & Rows.Count).End(xlUp).Row zone = Range("A1:A" & derlig) For i = 1 To UBound(zone) If InStr(feuilles, Chr(1) & Trim(UCase(zone(i, 1))) & Chr(1)) = 0 Then With ThisWorkbook.Worksheets.Add .Name = Trim(UCase(zone(i, 1))) feuilles = feuilles & Trim(UCase(zone(i, 1))) & Chr(1) DoEvents End With End If next
Dim oRange As Range Set oRange = Range(Range("A1"), Range("A1").End(xlDown))
Dim oSheet As Worksheet Dim bTrouvé As Boolean bTrouvé = False For Each oSheet In ActiveWorkbook.Sheets If oSheet.Name = "mon test" Then bTrouvé = True Exit For End If Next If bTrouvé Then MsgBox "La feuille ""mon test"" existe déjà" Else MsgBox "La feuille ""mon test"" n'existe pas" End If
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre questionOption Explicit Private Sub essai1() Dim derlig As Long, i As Integer, zone, feuilles, f As Worksheet, f_encours As String Dim oul As Long, ouc As Long feuilles = "" For Each f In Worksheets feuilles = feuilles & Chr(1) & Trim(UCase(f.Name)) Next feuilles = UCase(feuilles & Chr(1)) derlig = Range("B" & Rows.Count).End(xlUp).Row zone = Range("B2:I" & derlig) For i = 1 To UBound(zone) If InStr(feuilles, Chr(1) & Trim(UCase(zone(i, 1))) & Chr(1)) = 0 Then With ThisWorkbook.Worksheets.Add .Name = Trim(UCase(zone(i, 1))) feuilles = feuilles & Trim(UCase(zone(i, 1))) & Chr(1) DoEvents End With End If f_encours = Trim(LCase(zone(i, 1))) oul = 3 ouc = 2 If i = UBound(zone) - 1 Then Exit Sub Do While Trim(LCase(zone(i, 1))) = f_encours And i <= UBound(zone) If WorksheetFunction.CountIf(Worksheets(f_encours).Columns(1), zone(i, 3)) = 0 Then Worksheets(f_encours).Range("A" & oul).Value = zone(i, 3) oul = oul + 1 End If If WorksheetFunction.CountIf(Worksheets(f_encours).Rows(1), zone(i, 2)) = 0 Then Worksheets(f_encours).Cells(1, ouc).Value = zone(i, 2) ouc = ouc + 1 End If If i >= UBound(zone) Then Exit For If i <UBound(zone) - 1 Then i i + 1 Loop i = i - 1 Next End Sub
Dim toto As String For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row) On Error Resume Next toto = Worksheets(c.Text).Name If Err Then With ThisWorkbook.Worksheets.Add .Name = c.Text End With End If Err.Clear Next
mais en les nommant des valeurs que j'ai en colonne B.
Si tu veux savoir, je suis un ex-pétrolier donc ma spécialité n'a rien avoir avec le développement informatique