Discussion :

[djibysadji]

Bonsoir, le forum.
Je veux boucler sur les feuilles d'un classeur et appliquer la même mise en forme aux tableaux qu'elles contiennent en se basant sur le premier caractère à gauche du nom de la feuille.
Dans la capture jointe, j'ai par exemple un classeur avec deux feuilles dénommées respectivement Xdif et Xpil. Comment faire pour créer automatiquement avec vba le même tableau dans toutes les feuilles dont le nom commence par X.

[EricDgn]

Bonjour,

Quelque chose de ce genre devrait le faire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
 
Sub RecopierTableau()
    Dim rModele As Range, wsh As Worksheet
    Set rModele = Worksheets("Xdif").Cells
    For Each wsh In ThisWorkbook.Worksheets
        If Left(wsh.Name, 1) = "X" Then
            If wsh.Name <> "Xdif" Then
                rModele.Copy
                wsh.Range("A1").PasteSpecial xlPasteFormats
            End If
        End If
    Next wsh
    Application.CutCopyMode = False
    Set rModele = Nothing
End Sub

Cordialement.

[djibysadji]

Bonjour,

Quelque chose de ce genre devrait le faire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Option Explicit
 
Sub RecopierTableau()
    Dim rModele As Range, wsh As Worksheet
    Set rModele = Worksheets("Xdif").Cells
    For Each wsh In ThisWorkbook.Worksheets
        If Left(wsh.Name, 1) = "X" Then
            If wsh.Name <> "Xdif" Then
                rModele.Copy
                wsh.Range("A1").PasteSpecial xlPasteFormats
            End If
        End If
    Next wsh
    Application.CutCopyMode = False
    Set rModele = Nothing
End Sub

Cordialement.

Bonjour, votre code fonctionne certes, mais ce n'est pas exactement ce que je cherche. D'abord, votre code impose de coller à la cellule A1 alors que je voudrais pouvoir choisir selon mes besoins. Puis, je voudrais en même temps coller les mêmes entêtes du tableau.

Merci

[EricDgn]

Bonjour,

"je voudrais pouvoir choisir selon mes besoins". Dans ce cas, il me semble que des simples copier-coller seront plus efficaces, surtout si les différents tableaux n'ont pas le même nombre de lignes. Les macros, c'est pour répéter (plus ou moins exactement) la même chose.

Cependant, voici toujours quelque chose qui se rapproche, supposant qu'il n'y a que 1 tableau par feuille:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub RecopierLeTableau()
    Dim rModele As Range, rTitres As Range, wsh As Worksheet, rA1 As Range
    Set rModele = Worksheets("Xdif").UsedRange          '--- le tableau
    Set rTitres = rModele.Rows(1)                       '--- la première ligne du tableau
    For Each wsh In ThisWorkbook.Worksheets
        If Left(wsh.Name, 1) = "X" Then
            If wsh.Name <> "Xdif" Then
                Set rA1 = wsh.UsedRange.Cells(1, 1)     '--- cellule coin supérieur gauche du tableau déjà existant (ou A1 si pas de tableau)
                rModele.Copy
                rA1.PasteSpecial xlPasteFormats         '--- recopie les formats (sans écraser les données déjà inscrites)
                rTitres.Copy rA1                        '--- recopie la ligne de titres (en écrasant les titres déjà inscrits)
            End If
        End If
    Next wsh
    Application.CutCopyMode = False
    Set rA1 = Nothing
    Set rTitres = Nothing
    Set rModele = Nothing
End Sub

A tester, et adapter.
Cordialement.

[djibysadji]

Bonjour,

"je voudrais pouvoir choisir selon mes besoins". Dans ce cas, il me semble que des simples copier-coller seront plus efficaces, surtout si les différents tableaux n'ont pas le même nombre de lignes. Les macros, c'est pour répéter (plus ou moins exactement) la même chose.

Cependant, voici toujours quelque chose qui se rapproche, supposant qu'il n'y a que 1 tableau par feuille:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub RecopierLeTableau()
    Dim rModele As Range, rTitres As Range, wsh As Worksheet, rA1 As Range
    Set rModele = Worksheets("Xdif").UsedRange          '--- le tableau
    Set rTitres = rModele.Rows(1)                       '--- la première ligne du tableau
    For Each wsh In ThisWorkbook.Worksheets
        If Left(wsh.Name, 1) = "X" Then
            If wsh.Name <> "Xdif" Then
                Set rA1 = wsh.UsedRange.Cells(1, 1)     '--- cellule coin supérieur gauche du tableau déjà existant (ou A1 si pas de tableau)
                rModele.Copy
                rA1.PasteSpecial xlPasteFormats         '--- recopie les formats (sans écraser les données déjà inscrites)
                rTitres.Copy rA1                        '--- recopie la ligne de titres (en écrasant les titres déjà inscrits)
            End If
        End If
    Next wsh
    Application.CutCopyMode = False
    Set rA1 = Nothing
    Set rTitres = Nothing
    Set rModele = Nothing
End Sub

A tester, et adapter.
Cordialement.

Merci beaucoup pour le soutien! Exactement ce que je voulais.