copy valeurs, format of rows, of columns

[news]

Bonsoir à tous du forum,

j'utilise une macro, fonctionnant,
les données de Range A:K de la feuille("data") sont copiées dans beaucoup de feuilles,
ci-dessous aperçu de la macro, d'un exemple copiant le contenu d'une feuille dans 5 autres feuilles:

Sheets("data").Range("A:K").Copy ' copy contenu
Range("A1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Sheets("data").Rows("1:17").Copy ' copy format of rows
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Sheets("data").Columns("A:K").Copy ' copy format of columns
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("C20").Select

Cette macro semble être lourd, est-ce possible de réduire, de supprimer le texte répété ?

'

 

[skoobi]

Re : copy valeurs, format of rows, of columns

Bonjour,

dans le code "partiel" que tu as envoyé, on ne voit pas les 5 feuilles de destination.
Merci d'envoyer la partie manquante.

 

[news]

Re : copy valeurs, format of rows, of columns

Bonjour à tous du forum,

je remets le contenu de la macro

Sub ajoute_copy()
' nouvelles feuilles ajoutées avec nom repris des cellules C2:C20,
données de la feuille ("exemple_data") sont copiées sur les nouvelles feuilles

Dim plage As Range
Dim cn As Range
Dim n As Long
Dim c As String
Application.ScreenUpdating = False

Sheets(" data").Activate
n = Sheets.Count
Set plage = Range("C2:C" & Range("C65536").End(xlUp).Row)
For Each cn In plage
c = IIf(Len(cn.Value) > 32, Left(cn.Value, 31), cn.Value)
Sheets.Add After:=Sheets(n)
On Error Resume Next
ActiveSheet.Name = c

Sheets("exemple_data").Range("A:K").Copy ' copy contenu dans nouvelles feuilles Range("A1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Sheets("exemple_data").Rows("1:17").Copy ' copy format of rows
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Sheets("exemple_data").Columns("A:K").Copy ' copy format of columns
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("C20").Select
Next cn
End Sub

'

 

[skoobi]

Re : copy valeurs, format of rows, of columns

Re,

tu crés une autre procédure (copie_format) pour la copie des formats comme ceci:

.......
...
.........
Sheets("exemple_data").Range("A:K").Copy ' copy contenu dans nouvelles feuilles
Range("A1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("exemple_data").Rows("1:17").Copy ' copy format of rows
Call copie_format
Sheets("exemple_data").Columns("A:K").Copy ' copy format of columns
Call copie_format
[COLOR=red][B]Range("C20").Select[/B][/COLOR]
Next cn
End Sub

Sub copie_format()
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Sub

Ce qui est en rouge est à enlever car inutile et en plus ça ralentie la macro.

 

[news]

Re : copy valeurs, format of rows, of columns

Bonjour à tous du forum,

merci pour réponse, d'inclure le format dans une autre procédure ("sub copie format").
Est-ce qu'on peut réduire encore plus ?,

j'ai mis le code suivant comme macro, réduisant plus,
mais les données ne sont pas copiées sur les feuilles ajoutées, 😕

Sub ajoute_copy_feuille()
...
Application.Goto Reference:="exemple_data" ' sélectionne tout le contenu de la feuille("exemple_data") Selection.Copy
ActiveSheet.Select
ActiveSheet.Paste
Range("C20").Select
Next cn
End Sub


'

 

[news]

Re : copy valeurs, format of rows, of columns

Bonsoir à tous du forum,

j'ai recherché, fait nombreux essais, dont celui-ci réduit nettement :

Sheets("exemple_data").Rows("1:65536").Copy
Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False


code précédent trop long, alourdi :
Sheets("exemple_data").Range("A:K").Copy ' copy contenu dans nouvelles feuilles Range("A1").PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Sheets("exemple_data").Rows("1:17").Copy ' copy format of rows
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Sheets("exemple_data").Columns("A:K").Copy ' copy format of columns
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
'