1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
| Option Explicit
Sub Separer()
Dim sh As Worksheet, Feuille As Worksheet
Dim i As Integer, iRendu As Integer
Dim Verificateur As Boolean
Dim NomFeuille As String
Set sh = ActiveSheet
For i = 2 To Range("A65536").End(xlUp).Row
Verificateur = False
NomFeuille = sh.Cells(i, 1)
For Each Feuille In Worksheets
If Feuille.Name = NomFeuille Then
Verificateur = True
End If
Next Feuille
If Verificateur = False Then
Call AjouterFeuille(NomFeuille)
Else
Worksheets(NomFeuille).Activate
End If
iRendu = Range("A65536").End(xlUp).Row + 1
Worksheets(NomFeuille).Cells(iRendu, 1) = sh.Cells(i, 1)
Worksheets(NomFeuille).Cells(iRendu, 2) = sh.Cells(i, 2)
Worksheets(NomFeuille).Cells(iRendu, 3) = sh.Cells(i, 3)
Worksheets(NomFeuille).Cells(iRendu, 4) = sh.Cells(i, 4)
Next i
End Sub
Function AjouterFeuille(Nom As String)
Dim shNouveau As Worksheet
Dim sh As Worksheet
Set sh = ActiveSheet
Set shNouveau = Sheets.Add
shNouveau.Name = Nom
shNouveau.Cells(1, 1) = sh.Cells(1, 1)
shNouveau.Cells(1, 2) = sh.Cells(1, 2)
shNouveau.Cells(1, 3) = sh.Cells(1, 3)
shNouveau.Cells(1, 4) = sh.Cells(1, 4)
End Function |
Partager