VBA - fond en blanc

Bonjour à tous,

j'utilise une macro (qui n'a pas été réalisée par moi-même) qui me crée des onglets, un sommaire, et qui me copie des tableaux dans chaque onglet et les renomme.

Seulement, voilà, je souhaiterai, qu'avant la copie des tableaux dans chaque onglet, le fond de tous les onglets soit en blanc, et franchement je n'ai pas la moindre idée de comment faire ça

Merci d'avance à tous ceux qui essaieront de m'aider !

Bonne journée à tous

Voici le code :

Dim nb_q As Integer
Dim nb_l As Integer
Dim nb_c As Integer
Dim p As Integer
Dim j As Integer
Dim k As Integer
Dim Q As String
Dim Qbis As String
Dim cont As Worksheet
Dim data As Worksheet
Dim QAll As String
Dim Qcol2 As String
Dim QBisAll As String

' mise en forme basiques
Call largeur_cell(20, 12)
' Call paysage2

' Renomme la feuille courante en data
Sheets(ActiveSheet.Name).Name = "data"
Set data = Worksheets("data")

data.Select
Sheets.Add
Sheets(ActiveSheet.Name).Name = "Sommaire"
Set cont = Worksheets("Sommaire")

' Se positionne en A1
data.Select
data.Cells.Select

' compte le nombre de lignes et de colonnes de la selection
nb_r = Selection.Rows.Count
nb_c = Selection.Columns.Count

j = 0
k = 0
nb_q = 0

' boucle principale
For i = 1 To nb_r Step 1

    ' traitement des string en colonne 1
    QAll = data.Cells(i, 1).Value
    Qcol2 = data.Cells(i, 2).Value
    ' récupère la taille du premier mot :  jusqu'au premier espace
    p = InStr(QAll, " ")
    If p > 0 Then p = p - 1
    ' récupère le premier mot
    Q = Left$(QAll, p)
    ' initialise Qbis
    ' Qbis = "Q"
    ' si le premier mot commence par un Q
    If UCase(Left$(Q, 1)) = "Q" And Qbis <> Q And UCase(Left$(Qbis, 1)) = "Q" And Qcol2 = "" Then
            k = i - 1
              If k > 0 Then
                nb_q = nb_q + 1

                ' met à jour Sommaire
                cont.Activate
                cont.Cells(nb_q + 3, 1).Value = Qbis
                cont.Cells(nb_q + 3, 1).Activate
                   ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
                Qbis + "!A2", TextToDisplay:=QBisAll

                ' ajout de feuille
                data.Select
                Sheets.Add
                Sheets(ActiveSheet.Name).Name = Qbis

                ' selectionne tableau
                Sheets("data").Select
                Range(data.Rows(j), data.Rows(k)).Select
                ' copie
                Selection.Copy
                Sheets(Qbis).Activate
                ' colle
                Rows("2:2").Select
                Selection.Insert Shift:=xlDown
                Call largeur_cell(8, 12)
                ' Call paysage1
            End If

            'f i = 0 Then

                ' met à jour Sommaire
             '  cont.Activate
             '  cont.Cells(nb_q + 2, 1).Value = QAll
             '  cont.Cells(nb_q + 2, 1).Activate
             '  ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
             '  Q + "!A2", TextToDisplay:=QAll
          ' End If

            j = i
    End If

    ' renseigne question précédente
    If UCase(Left$(Q, 1)) = "Q" And Qcol2 = "" Then
        Qbis = Q
        QBisAll = QAll
        If j = 0 Then j = i
    End If

    ' derniere question
    If i = nb_r Then
             ' met à jour Sommaire
                cont.Activate
                cont.Cells(nb_q + 4, 1).Value = Qbis
                cont.Cells(nb_q + 4, 1).Activate
                   ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:= _
                Qbis + "!A2", TextToDisplay:=QBisAll

        ' ajout de feuille
        data.Select
        Sheets.Add
        Sheets(ActiveSheet.Name).Name = Qbis

        ' selectionne tableau
        Sheets("data").Select
        Range(data.Rows(j), data.Rows(i)).Select
        ' copie
        Selection.Copy
        Sheets(Qbis).Activate
        ' colle
        Rows("2:2").Select
        Selection.Insert Shift:=xlDown
        ' Call paysage1
        Call largeur_cell(8, 12)
    End If
Next

cont.Activate

End Sub

Bonjour

Code qui affecte la couleur blanche à l'onglet de la feuille 3

Sub Color_Onglet()
'
' Color_Onglet Macro
'
    Sheets("Feuil3").Select
    With ActiveWorkbook.Sheets("Feuil3").Tab
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    ActiveCell.Select
End Sub

Amicalement

Pierrot