Microsoft 365 Remplir des cellules automatiquement

[Fanny53]

Bonjour, j’ai un classeur Excel, qu’une personne ma fait, car je ne connais pas du tout Excel.
Remplir les cellules est la seule chose que je sache faire.

Ma question Existe-t-il une formule ou une Macro qui puisse remplir automatiquement les champs d’une feuille à partir d’une autre feuille automatiquement.
Merci d’avance pour votre aide.

 

[job75]

Le VBA de votre fichier post #55 est lourd et complique inutilement le fichier qui n'est pas cohérent.

Prenez le temps d'étudier mon fichier post #59, il est simple et cohérent.

 

[job75]

Ah mais pardon, j'avais mal compris : chaque étiquette doit porter le titre de la face A et le titre de la face B;

C'est donc plus simple, formule en Données!F6 =SI([@JUKE]="CAPRI";MAX(F$5:F5)+1;"")

Et le tri de la feuille "Données" n'est même plus nécessaire :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not Sh.Name Like "Etiquettes *" Then Exit Sub
Dim s As Shape, col As Range, i&
Application.ScreenUpdating = False
Sh.[C2:G2].ShrinkToFit = True: Sh.[I2:M2].ShrinkToFit = True 'commande Ajuster
Sh.[D3:F3].ShrinkToFit = True: Sh.[J3:L3].ShrinkToFit = True 'commande Ajuster
Sh.[C4:G4].ShrinkToFit = True: Sh.[I4:M4].ShrinkToFit = True 'commande Ajuster
For Each s In Sh.Shapes
    If s.TopLeftCell.Row > 3 Then s.Visible = False 'repérage des Shapes existantes
Next s
Sh.DrawingObjects.Placement = 2 'déplacer sans dimensionner avec les cellules
Rows("5:" & Rows.Count).Delete 'RAZ
With Sheets("Données").ListObjects(1).Range 'tableau structuré
    Set col = .Columns(Application.Match(Trim(Split(Sh.Name)(1)), .Rows(1), 0))
End With
For i = 3 To Application.Max(col) Step 2
    Rows("1:4").Copy Rows(2 * i - 1) 'copier-coller
Next i
For Each s In Sh.Shapes
    If s.Visible = False Then s.Delete 'RAZ
Next s
End Sub

 

[job75]

Avec ce fichier (2) on utilise des étiquettes sans flèches sur 4 colonnes :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If Not Sh.Name Like "Etiquettes *" Then Exit Sub
Dim col As Range, i&
Application.ScreenUpdating = False
Sh.Rows("2:4").ShrinkToFit = True 'commande Ajuster
Rows("5:" & Rows.Count).Delete 'RAZ
With Sheets("Données").ListObjects(1).Range 'tableau structuré
    Set col = .Columns(Application.Match(Trim(Split(Sh.Name)(1)), .Rows(1), 0))
End With
For i = 5 To Application.Max(col) Step 4
    Rows("1:4").Copy Rows(i) 'copier-coller
Next i
End Sub

Bonne nuit.

 

[Fanny53]

Bonjour Job 75,
Merci d’avoir pris le temps de travailler sur mon dernier fichier.
Je pense que je me suis mal exprimée concernant ma demande. J’ai besoin à la fois de la feuille Étiquettes DISCO et de la feuille Étiquettes avec la possibilité de modifier les couleurs, comme l’avait fait Phil69970.

En relisant l’ensemble des posts du forum, j’ai réussi à supprimer la partie ROCK, comme je le souhaitais.

Le fichier est peut-être lourd et pas toujours très cohérent pour vous, mais pour moi, il correspond bien à mon usage.

 

[job75]

Bonqoir Fanny53,

Ma mission est donc terminée.

A+

 

[Fanny53]

Bonjour Job75 ,

Oui, en effet. Merci encore pour votre aide et votre disponibilité.

Bonne continuation,
A+