Copier coller formule et format

Bonjour,

La macro ci-dessous fonctionne correctement, à savoir crée autant d'onglet que de section.

Par contre, je ne récupère que des valeurs. Je souhaiterai récupérér également les formules et formats aussi bien pour la 1ere ligne "étiquettes" que pour les valeurs.

Merci pour vos conseils avisés.

Sub sections()

'Exportation avec suppression

Dim i&, x&, F As Worksheet

'Bloquer l'affichage écran

Application.ScreenUpdating = False

'Bloquer les alertes

Application.DisplayAlerts = False

'Avec la Feuille 1 (Nom a adapter)

With Sheets("PREP")

'/!\ *** Suppression de toutes les feuilles*** /!\

'Pour chaque feuille du classeur

For Each F In Worksheets

'Si le nom de la feuille n'est pas Feuil1, on la supprime

If F.Name <> .Name Then F.Delete

'Prochaine feuille

Next F

'/!\ ***************************************** /!\

'Pour chaque ligne (i) de feuil1

For i = 2 To .Cells(Rows.Count, 1).End(xlUp).Row

'Si il y a une erreur on passe à ligne suivante

On Error Resume Next

'On dit que F est la feuille du nom de la cellule

'ligne i colonne 21 (U)

'Si la feuille n'existe pas il y a une erreur gérée par "On Error Resume Next"

Set F = Sheets(.Cells(i, 21).Value)

'si il y a une erreur on l'annule

On Error GoTo 0

'Si F n'est rien (donc si la feuille n'éxiste pas

If F Is Nothing Then

'on la crée en lui donnant comme nom la valeur de la cellule

'ligne i colonne 21 (U)

Sheets.Add(After:=Sheets(Sheets.Count)).Name = .Cells(i, 21)

'Comme on crée la feuille on met l'en-tête des colonnes

'de A1 à U1

ActiveSheet.Range("A1:U1").Value = .Range("A1:U1").Value

'Fin de la condition

End If

'On cherche la première ligne vide de la bonne feuille (X)

x = Sheets(.Cells(i, 21).Value).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

'on met les valeurs des cellules de A à U de la feuille Feuil1

'de la ligne i dans les cellules de A à U de la ligne X de la bonne feuille

Sheets(.Cells(i, 21).Value).Range("A" & x & ":U" & x).Value = .Range("A" & i & ":U" & i).Value

'On dit que F n'est rien (préparation de la prochaine boucle)

Set F = Nothing

'Prochaine ligne de la feuille feuil1

Next i

'*** Mise en forme de toutes les feuilles (facultatif)***

'Pour chaque feuille du classeur

For Each F In Worksheets

'Si le nom de la feuille n'est pas Feuil1, on ajuste les colonnes

If F.Name <> .Name Then F.Columns.AutoFit

'Prochaine feuille

Next F

'********************************************************

'On active la feuille Feuil1 pour finir dessus

.Activate

'Arret de l'utilisation de la feuil1

End With

'Réactivation des alertes

Application.DisplayAlerts = True

'Réactivation de l'écran

Application.ScreenUpdating = True

'Message de fin de traitement

MsgBox "Exportation terminée", 64, "Compte-rendu"

End Sub

Bonjour,

Peux-tu joindre un fichier?

Cdlt

Bonjour

voici le fichier test.

Bonjour fdk,

Sauf erreur de ma part, je ne vois aucun lien vers ton fichier

Cordialement,

uras

sorry, je ne l'avais pas inséré dans le message.

Re,

Pour le format, tu devrais t'en sortir avec les propriétés Interior(.Color) (pour l'intérieur) ,Font (pour la police) et Border (pour les bordures) de l'objet Range (j'ai vu que tu utilisais que des .Value). Utilise l'aide du développeur (F1) si besoin.

Pour les formules, il me faut plus d'explications (La fomule "copiée" utilise-t'elle les mêmes cellules ou doit-elle être ajustée par rapport aux nouvelles données?)

Cordialement,

uras

La formule est calculée pour toutes les personnes dans l'onglet de base et doit être copiée dans tous les onglets.

actuellement, la formule est renvoyée en valeur.

re,

Essaye ça, je n'ai pas réussi à trouver une méthode simple pour garder ta mise en forme (au niveau police et bordures)

le bout de code qui a changé :

'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\      CHANGEMENT A PARTIR D'ICI       /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\

Dim j As Integer 'Nouvelle variable => compteur pour les colonnes

Sheets(.Cells(i, 21).Value).Range("A1:U1").AutoFilter 'FILTRE SUR ENTETE

'Fin de la condition
End If
'On cherche la première ligne vide de la bonne feuille (X)
x = Sheets(.Cells(i, 21).Value).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
'on met les valeurs des cellules de A à U de la feuille Feuil1
'de la ligne i dans les cellules de A à U de la ligne X de la bonne feuille
        For j = 1 To 21
        'Au lieu de copier ligne par ligne, on met les valeurs cellule par cellule
            If j = 19 Then 'Colonne S (contient une formule)
                'Sheets(.Cells(i, 21).Value).Cells(x, j).Formula = .Cells(i, j).Formula 'formule identique
                Sheets(.Cells(i, 21).Value).Cells(x, j).Formula = "=" & .Cells(x, 10).Address & "*" & .Cells(x, 13).Address & "%" 'Formule réecrite
                Sheets(.Cells(i, 21).Value).Cells(x, j).Interior.Color = .Cells(i, j).Interior.Color
            Else 'Colonne ne contenant pas de formule
                Sheets(.Cells(i, 21).Value).Cells(x, j).Value = .Cells(i, j).Value
                Sheets(.Cells(i, 21).Value).Cells(x, j).Interior.Color = .Cells(i, j).Interior.Color
            End If
        Next j
'Sheets(.Cells(i, 21).Value).Range("A" & x & ":U" & x).Value = .Range("A" & i & ":U" & i).Value

'Je n'ai pas reussi à copier les bordures et la police facilement pour la mise en forme, je te laisse chercher
'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\             FIN CHANGEMENT           /\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\
'/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\

En esperant t'avoir aider!

uras