Option Explicit
Sub ReportEnregistrements()
Dim Rep As String, Lig As Integer, X As Byte
Dim Tablo1, i As Long, j As Integer, K As [COLOR=red]Integer[/COLOR], Derlig As Long
Application.ScreenUpdating = False
' Vérification de décision
Rep = MsgBox("Souhaitez-vous dispatcher les données par point de vente ?" & Chr(10) _
& " ", Chr(10) _
& vbYesNo + vbQuestion + vbDefaultButton2, "CONTRÔLE AVANT EFFACEMENT ET TRANSFERT")
If Rep = vbNo Then Exit Sub
' Effacement de toutes les feuilles autres que ModeMenu et modele
For i = Sheets.Count To 1 Step -1
If Sheets(i).Name <> "ModeMenu" And Sheets(i).Name <> "Modele" Then
Application.DisplayAlerts = False
Sheets(i).Delete
Application.DisplayAlerts = True
End If
Next i
' Ddernière ligne de la base
With Sheets("modeMenu")
Lig = .Range("A65536").End(xlUp).Row
' Tri de la base par ordre croissant des ref des points de vente
.Range("A6:H" & Lig).Sort Key1:=.Range("A6"), Order1:=xlAscending
' Mise en tableau des données de la base
Tablo1 = .Range("A6:[COLOR=red]IV[/COLOR]" & Lig)
' Création des feuilles des points des ventes
For i = 1 To UBound(Tablo1, 1)
X = 0
For j = 1 To Sheets.Count
' Vérification d'existance de la feuille
If CStr(Tablo1(i, 1)) = Sheets(j).Name Then
X = 1
Exit For
End If
Next j
If X = 1 Then ' Feuille existante
With Sheets(j)
Derlig = .Range("B65536").End(xlUp).Row
For K = 1 To [COLOR=red]255[/COLOR]
.Cells(Derlig + 1, K) = Tablo1(i, K + 1)
Next K
End With
Else ' Feuille inexistante
Sheets("Modele").Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Name = Tablo1(i, 1)
For K = 1 To [COLOR=red]255[/COLOR]
.Cells(6, K) = Tablo1(i, K + 1)
Next K
End With
End If
Next i
.Activate
End With
End Sub